pax_global_header00006660000000000000000000000064113337710050014512gustar00rootroot0000000000000052 comment=b7e0d29d82ea2c8110758d63cd6c0cbe6188437c cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/000077500000000000000000000000001133377100500200265ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/ChangeLog000066400000000000000000000145631133377100500216110ustar00rootroot000000000000002006-01-21 Rudi Schlatte * aserve/proxy.cl (write-body-buffers): initialize len to numeric value in all cases 2005-07-05 Klaus Harbo * acl-compat/lispworks/acl-socket.lisp (make-ssl-client-stream): Support for LispWorks' own SSL facilities. 2005-06-17 Edi Weitz * acl-compat/lispworks/acl-excl.lisp (filesys-inode): Conditionalize. It's only used on Unix and otherwise the code won't even compile on Windows. 2004-10-01 Kevin Rosenberg * acl-compat/mcl/acl-mp: Apply portability patch from Gary Byers to fix filesys-inode for linux 2004-09-24 Kevin Rosenberg * acl-compat/sbcl/acl-mp.lisp: Apply patch from Gabor Melis to fix type [portableaserve-discuss@lists.sourceforge.net]. 2004-08-31 Kevin Rosenberg * Fix ipaddr-to-hostname for SBCL * Fix for request-query-value for SBCL 2004-08-30 Kevin Rosenberg * Fixes for compilation on SBCL * Add support for :cookie-domain for webactions 2004-08-04 Kevin Rosenberg * Commit patch from Chaskiel M Grundman for better Allegro support 2004-06-09 Kevin Rosenberg * Commit patch from Nick Levin addressing compilation on Lispworks 2004-04-26 Kevin Rosenberg * aserve/webactions: Commit patch, with modifications, from Ivan Toshkov * aserve/load.cl: Add implemenatation of compile-file-if-needed 2004-02-16 Rudi Schlatte * libs/cl-ppcre/: Import Edi Weitz's cl-ppcre library. * INSTALL.lisp: load it. * aserve/test/t-aserve.cl (test-publish-directory): Correct directory regexp (put some more leaning toothpicks in) * aserve/main.cl: Remove meta-based date-to-universal-time function; the shiny new match-regexp can handle these expressions. 2004-02-08 Rudi Schlatte * aserve/webactions/webact.cl, aserve/webactions/clpage.cl, aserve/test/t-aserve.cl, aserve/proxy.cl, aserve/main.cl, aserve/log.cl, aserve/chat.cl, aserve/client.cl, aserve/cgi.cl: Use package puri throughout. * INSTALL.lisp: Removed warnings for loading the provided-by-us versions of asdf et al. Load puri library before acl-compat. Remove MCL-specific handling. 2004-01-27 Rudi Schlatte * INSTALL.lisp: clean up a bit, merge sbcl, cmu and lispworks loading code. * Replaced package prefix excl: with acl-compat.excl: throughout. * aserve/main.cl (connection-reset-error): Hackishly implement for OpenMCL and conditionalize allegro-specific function call -- this should fix stray hangs (caused by threads wanting to enter the debugger) on all platforms. 2004-01-21 Rudi Schlatte * contrib/asdf.lisp: New upstream version. 2004-01-11 Rudi Schlatte * aserve/cgi.cl: Frob package references to acl-compat ones. * aserve/main.cl: Added setuid / setgid for sbcl. 2003-12-02 Rudi Schlatte * Update to upstream version 1.2.33 2003-12-01 Rudi Schlatte * aserve/log.cl (log-request): Don't output request string via format. 2003-11-27 Rudi Schlatte * aserve/test/t-aserve.cl: Don't assume that long-site-name returns a FQDN; better fixes than just using "localhost" welcome (but these will be implementation-specific, I fear...) 2003-11-06 Rudi Schlatte * aserve/htmlgen/htmlgen.cl (html-standard-print): Fix bug reported by Sean Ross to portableaserve-help (2003-11-06): output the closing tags to the given stream, not standard-output 2003-08-31 Rudi Schlatte * aserve/test/t-aserve.cl: First steps for activating test code, using kmr's port of Franz's tester 2003-04-27 Rudi Schlatte * aserve/parse.cl (read-headers-into-buffer): (Finally) merge debug code fix from Walter C. Pelissero 2003-04-02 Rudi Schlatte * aserve/example.cl: Prettified aserve/example.cl: make sensible start-server, start-simple-server functions (Allegro's original examples are in aserve/examples/ nowadays) 2003-03-24 Rudi Schlatte * aserve/client.cl (do-http-request): Restore :format :text behavior (broke this last summer.. sorrysorrybowbow) 2003-02-28 Rudi Schlatte * INSTALL.lisp: Support sbcl 0.7.13 single-threaded 2002-07-19 Rudi Schlatte * contrib/lsp.lisp (Module): Lisp Server Pages, contributed by John Wiseman via http://lemonodor.com/archives/000128.html * contrib/session.lisp (Module): Session support, contributed by Brendan Burns to Franz's opensource list 2002-07-07 Rudi Schlatte * cmucl version now uses asdf instead of mk-defsystem: ** Added directory contrib, contrib/asdf.lisp ** Added acl-compat/acl-compat.asd, aserve/aserve.asd, aserve/htmlgen/htmlgen.asd (thanks to David Lichteblau for the asd files) ** Updated README.cmucl, README * Changed client.cl to use http/1.0 (Remember to revert this when chunking is implemented!) (Thanks to David Lichteblau for bug report & patch) Changes in Portable AllegroServe 1.2.5a (2001-08-30) - Chunking implemented for Lispworks. - Fixed problem in Lispworks port with accepting too many connections (and consequently running out of file descriptors) under heavy load. - Incorporated changes in AllegroServe between versions 1.2.3 and 1.2.5. Changes in Portable AServe 1.2.3b (09.08.2001) - Fixed bug with POST requests - General code cleanup - implemented some missing ACL-COMPAT functions Changes in AServe for LW 1.2.3a (06.08.2001) - Rudolf Schlatte's changes for supporting CMUCL merged. - Several critical bugs fixed (like the lockup of worker-threads that occured on higher load). (Thanks go to Vebjorn Ljosa for finding and fixing this and other critical bugs) - Updated Portable AllegroServe to the changes in Franz AllegroServe 1.2.3 Changes in AServe for LW 1.1.41b (02.06.2001) - Fixed reloading of pages Wade Humeniuk kindly contributed a DATE-TO-UNIVERSAL-TIME function that doesn't use MATCH-REGEXP. Changes in ACL-COMPAT (02.06.2001) - MATCH-REGEXP got a Keyword argument :return - Much improved MP:WITH-TIMEOUT using LispWorks timers and not a new process for each timer. - Fixed a bug in scan-macros.lisp where complementing of charsets did not really work. cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/INSTALL.lisp000066400000000000000000000071671133377100500220400ustar00rootroot00000000000000;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: CL-USER; -*- (in-package "CL-USER") (defun ensure-asdf () #+asdf (return-from ensure-asdf t) #+sbcl (require :asdf) #-sbcl (let ((asdf-pathname (merge-pathnames (make-pathname :directory '(:relative "libs") :name "asdf" :case :local) *load-truename*))) (load asdf-pathname))) (ensure-asdf) (progn (flet ((find-or-load-system (system path) (let ((path (merge-pathnames path *load-truename*))) (unless (asdf:find-system system nil) (load path))))) (find-or-load-system :puri (make-pathname :directory '(:relative "libs" "puri-1.3.1") :name "puri" :type "asd" :case :local)) (find-or-load-system :cl-ppcre (make-pathname :directory '(:relative "libs" "cl-ppcre") :name "cl-ppcre" :type "asd" :case :local)) (find-or-load-system :acl-compat (make-pathname :directory '(:relative "acl-compat") :name "acl-compat" :type "asd" :case :local)) (find-or-load-system :htmlgen (make-pathname :directory '(:relative "aserve" "htmlgen") :name "htmlgen" :type "asd" :case :local)) (find-or-load-system :aserve (make-pathname :directory '(:relative "aserve") :name "aserve" :type "asd" :case :local)) (find-or-load-system :webactions (make-pathname :directory '(:relative "aserve" "webactions") :name "webactions" :type "asd" :case :local))) ;; Compile and load the ASERVE system (asdf:operate 'asdf:load-op :aserve) (asdf:operate 'asdf:load-op :webactions) ;; Startup multiprocessing. ;; ;; this isn't strictly necessary, but scheduling feels very coarse ;; before the evaluation of (startup-idle-and-top-level-loops) -- ;; answer delays of about 1s per http request. ;; ;; KLUDGE: startup-idle-and-top-level-loops can only be evaluated ;; once, so we look for something resembling an existing idle loop ;; before invoking it. #|| #+mp (unless (find-if #'(lambda (proc) (string= (mp:process-name proc) "Idle Loop")) (mp:all-processes)) (mp::startup-idle-and-top-level-loops)) ||# ;; DOUBLE KLUDGE: The preceding (commented-out) form caused the ;; loading of INSTALL.lisp to abort silently (!), so we do the ;; following, pilfered from eclipse the window manager: #+(and cmu mp) (setf mp::*idle-process* mp::*initial-process*) ) #|| ;;; To test the installation, evaluate the following: ;;; Load example.lisp in the aserve directory. (load "aserve:example.cl") ;;; Select example package (in-package :aserve-example) ;;; This option enables extended debug message output (net.aserve::debug-on :info) ;;; This option enables to enter the debugger if an error ;;; occurs. (instead of simply logging and ignoring it) (net.aserve::debug-on :notrap) ;;; Start example server (in multiprocessing) on port 2001 (start-server :port 2001) ;; SSL server example (start-server :port 2443 :ssl (lispworks:example-file "ssl/cert-and-key.pem") :ssl-password "123456") ;MCL/OpenMCL note: chunking is not yet implemented so use (start-server :port 2001 :chunking nil) ||# cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/README000066400000000000000000000021461133377100500207110ustar00rootroot00000000000000README -- This is a short description of what you will find in the subdirectories of this archive ./acl-compat/ Several ACL compatibility hacks ./aserve/ The AServe source ./debian/ Debian package files ./contrib/ Additional useful (?) code contributed by users ./logical-hostnames.lisp Some logical-pathname-translations needed by defsys ./README This file ./README.cmucl Additional documentation for CMU Common Lisp ./INSTALL.lisp Quick installation The quick-installation script compiles and loads Portable AllegroServe. Loading the file aserve:example.cl and evaluating (aserve-example::start-server :port 2001) starts an AllegroServe server on http://localhost:2001 that shows off some of the things possible with AllegroServe. Depending on the Lisp implementation, it might be necessary to give additional arguments :chunking nil and/or :listeners 0, since chunked transfer encoding and multi-threading are not supported everywhere. Regards, Jochen Schmidt -- jsc@dataheaven.de http://www.dataheaven.de cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/README.cmucl000066400000000000000000000066541133377100500220230ustar00rootroot00000000000000Hey emacs, this is -*- text -*- CMU Common Lisp-specific requirements 0. Executive summary To begin, just load INSTALL.lisp. Then, load aserve/examples/examples.cl and start the server with (net.aserve:start :port 8080) If you experience problems or want to get rid of some annoying warnings, read on. 1. Man, this is S_L_O_W! This is unusable! Chances are you are an experienced user and loaded aserve through asdf (see next section on some words about that) instead of loading INSTALL.lisp. If so, you will likely be experiencing request answer times of about 1 second -- per request, so you can see these 1 pixel transparent GIFs arrive one after the other ... Take a look at INSTALL.lisp or the function cl-user::init-aserve-cmu in aserve.asd. Once the multiprocessing is initialized by one of these methods, the server will be quite a bit more responsive. 2. asdf (Another System Definition Facility) asdf is Dan Barlow's CLOSsy defsystem facility. A defsystem is the Lisp equivalent of the Unix "make" utility; i.e. we can tell it to compile / load a system, and it knows what files to operate on in what order. For further information about asdf, start at . Since asdf is not (yet?) included with Common Lisp implementations, we have placed it in the contrib/ directory. The maintainers will try to keep the included version synched with upstream. Please write to portableaserve-discuss@lists.sourceforge.net if you notice our version has grown old! If you want to get rid of the (harmless) warnings during INSTALL.lisp, load asdf in your Lisp initialisation file ~/.cmucl-init. If you do that, you might also want to add a location for ASDF systems to the variable ASDF:*CENTRAL-REGISTRY*, for example (push "/home/rudi/lisp/systems/" asdf:*central-registry*) Then link all the asd files to that path, with something like: $ ln -sf /home/rudi/lisp/portableaserve/acl-compat/acl-compat.asd ~/systems/ $ ln -sf /home/rudi/lisp/portableaserve/aserve/aserve.asd ~/systems/ $ ln -sf /home/rudi/lisp/portableaserve/aserve/htmlgen/htmlgen.asd ~/systems/ After all that hassle, what's in it for you? Well, from then on, you can just evaluate (asdf:operate 'asdf:load-op :aserve) to load AllegroServe, and systems of your own can depend on aserve if they use it, so that it gets loaded automatically when needed. In that case, have a look at the multiprocessing workarounds in INSTALL.lisp or the function cl-user::init-aserve-cmu (defined in aserve.asd); one of these is needed, or you will be unhappy with the request answer times you get :) 3. Gray streams Portable Allegroserve needs Gray stream support in the Lisp image it's running in. The file acl-compat.asd should load the required files automatically, if gray streams are not yet present in the Lisp image during system compile / load. If you experience problems, please report them to the portableaserve mailing list; be sure to include your version of cmucl, where you obtained it, where its files are placed in your system, etc. Failing to cleanly load acl-compat.asd is considered a bug; don't hesitate to report it as such. As it is, users reported success both on Debian systems and with the cmucl distribution from cons.org, so it will likely Just Work (tm). Have fun, Rudi Schlatte rudi@constantly.at cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/000077500000000000000000000000001133377100500220465ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/CREDITS000066400000000000000000000033251133377100500230710ustar00rootroot00000000000000-*- text -*- CREDITS; a.k.a. the history of Portable AllegroServe This was written by Rudi Schlatte, who (knowing himself) is sure he forgot some important contributors. Please mail me (rudi at constantly.at) to point out any inconsistencies, don't be shy! * Corman Lisp The code that started it all. Chris Double took Allegro's open-sourced code, got it to run on Corman Lisp and released the code.. After Portable AllegroServe got off the ground, he re-arranged his port so that it fit in the structure of acl-compat. * Xanalys LispWorks Jochen Schmidt ported Chris Double's AllegroServe port to LispWorks, laid the groundwork for the "Portable" part of paserve and started the SourceForge project. * cmucl cmucl was the third Lisp implementation to run Portable AllegroServe. The port was done by Rudi Schlatte during his military service out of sheer boredom. * Digitool MCL John DeSoi contributed this port and kept it working when the antics of other developers broke his code once again. * OpenMCL Also done by John DeSoi. Gary Byers himself later contributed code to support OpenMCL's OS-level threads (OpenMCL version 14 and up) in an efficient way. * sbcl This port was done by Rudi Schlatte, using Daniel Barlow's sbcl multiprocessing code in the McCLIM GUI project as inspiration. * clisp Also by Rudi Schlatte. Since clisp has no support for threads, neither does acl-compat on this platform. Code can still be compiled, however. * Scieneer Common Lisp This port was contributed by Douglas Crosher. * Allegro Common Lisp It may seem strange to implement an API on top of itself, but Kevin Rosenberg's implementation makes it possible to run systems that use acl-compat on ACL itself without source changes. cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/ChangeLog000066400000000000000000000262021133377100500236220ustar00rootroot000000000000002006-01-22 Rudi Schlatte * sbcl/acl-mp.lisp (defun/sb-thread): silence compilation style warning on single-threaded sbcl * sbcl/acl-excl.lisp (filesys-type): Fix bogus variable name :( 2006-01-21 Rudi Schlatte * sbcl/acl-excl.lisp (filesys-type, filesys-inode): use sb-posix instead of sbcl internals 2005-08-05 Gabor Melis * sbcl/acl-mp.lisp: updated to use the thread object api available since sbcl 0.9.2 2004-02-17 Rudi Schlatte * acl-excl-common.lisp (match-regexp): Make :return :index return values same as ACL 2004-02-16 Rudi Schlatte * acl-compat.asd: - Add some meta-information to system definition - Fix bug: all but the first :depends-on arguments are silently ignored. :/ 2004-02-16 Rudi Schlatte * packages.lisp: Remove references to nregex package. * acl-excl-common.lisp (match-regexp, compile-regexp): Implement using cl-ppcre. * acl-compat.asd: Eliminate meta and nregex, use cl-ppcre instead. 2004-02-14 Rudi Schlatte * acl-compat.asd: Make Gray streams loading on cmucl a little bit saner (but only a little bit) * chunked-stream-mixin.lisp: Don't add to *features*, remove provide form. 2004-02-08 Rudi Schlatte * acl-compat.asd: Introduce dependency on puri, remove meta and uri.lisp 2004-02-02 Rudi Schlatte * cmucl/acl-mp.lisp (process-run-function): Give the new process a run reason, so that it doesn't hang from the start. * cmucl/acl-socket.lisp (get-fd): Added method for server-socket. 2004-01-28 Rudi Schlatte * packages.lisp: excl -> acl-compat.excl * lispworks/acl-socket.lisp: ditto. 2004-01-27 Rudi Schlatte * chunked-stream-mixin.lisp: replace excl: package prefix with acl-compat.excl: 2004-01-26 Rudi Schlatte * mcl/acl-excl.lisp (fixnump): new function. * packages.lisp (:acl-compat.excl): Remove "excl" nickname. * clisp/acl-excl.lisp (fixnump): new function. 2004-01-24 Rudi Schlatte * acl-excl-common.lisp (string-to-octets): null-terminate vector when asked to. * cmucl/acl-excl.lisp, lispworks/acl-excl.lisp, mcl/acl-excl.lisp, sbcl/acl-excl.lisp, scl/acl-excl.lisp: Move write-vector, string-to-octets to commmon file. * acl-excl-common.lisp: Moved write-vector, string-to-octets from implementation-specific files. 2004-01-19 Rudi Schlatte * scl/acl-excl.lisp, sbcl/acl-excl.lisp, mcl/acl-excl.lisp, lispworks/acl-excl.lisp, cmucl/acl-excl.lisp, clisp/acl-excl.lisp: Remove common functionality from implementation-specific files, dammit! * acl-compat.asd: Added acl-excl-common. * acl-excl-common.lisp: New file. 2004-01-18 Rudi Schlatte * acl-excl-corman.lisp (intern*), sbcl/acl-excl.lisp (intern*), mcl/acl-excl.lisp (intern*), lispworks/acl-excl.lisp (intern*), cmucl/acl-excl.lisp (intern*), clisp/acl-excl.lisp (intern*), scl/acl-excl.lisp (intern*): Don't upcase symbol before interning (thanks to Marco Baringer, whose code was broken by this). Now I'm motivated to factor out common code from all the backends ... * cmucl/acl-mp.lisp (apply-with-bindings): Fix "How did this ever work" typo; thanks to Marco Baringer. 2004-01-11 Rudi Schlatte * sbcl/acl-socket.lisp (make-socket): Handle :local-port nil, don't bind socket in that case (let os choose a port) 2004-01-11 Rudi Schlatte * packages.lisp (defpackage acl-compat.excl): Export some symbols for mcl, too * mcl/acl-excl.lisp (run-shell-command): Implement (largely untested for now, needed for cgi support) * mcl/acl-sys.lisp (command-line-argument, command-line-arguments): Implement for OpenMCL * mcl/acl-mp.lisp (wait-for-input-available): Implement. Needed for cgi support. * mcl/acl-socket-openmcl.lisp (server-socket): Remove :type slot argument. * sbcl/acl-socket.lisp (make-socket): Add reuse-address argument. * cmucl/acl-socket.lisp (make-socket): Add reuse-address argument. * acl-compat.asd: Load sb-posix for sbcl. 2003-12-15 Rudi Schlatte NOTE: this checkin has a reasonable chance of breaking (and mcl (not openmcl)) * mcl/acl-socket-openmcl.lisp: Remove package definition, implement chunked transfer encoding (accepting a speed loss in the process) * mcl/acl-excl.lisp, mcl/acl-mp.lisp, mcl/acl-sys.lisp: remove package definitions * uri.lisp: deftype also at load time; openmcl breaks otherwise * packages.lisp: mcl doesn't have stream-(read,write)-sequence * lw-buffering.lisp: formatting frobs. * acl-compat.asd: Merge mcl defsystem with the others. * sbcl/acl-socket.lisp: Use acl-compat.socket package name. 2003-12-02 Rudi Schlatte * meta.lisp (enable-meta-syntax): Save current readtable before installing *meta-readtable*. 2003-12-01 Rudi Schlatte * chunked-stream-mixin.lisp: Merge Lispworks patch from Edi Weitz (paserve-help 2003-11-28) 2003-11-27 Rudi Schlatte * chunked-stream-mixin.lisp (gray-stream:stream-fill-buffer): LispWorks refill-buffer does not always return the amount of bytes read (reported by Edi Weitz to paserve-discuss 2003-11-26). Treat its return value as a boolean. * lw-buffering.lisp (stream-fill-buffer): Remove cmucl-specific read-n-bytes call because it does block after all :( * chunked-stream-mixin.lisp (gray-stream:stream-fill-buffer): Fix for Lispworks client mode contributed by Edi Weitz to paserve-discuss list on 2003-11-25 * sbcl/acl-mp.lisp: Single-threaded "implementation" of process-name 2003-09-19 Rudi Schlatte * sbcl/acl-mp.lisp: Merged threading patch from Brian Downing (posted to portableaserve-discuss 2003-09-12) * clisp/acl-excl.lisp, clisp/acl-socket.lisp: Eliminate compile failures, activate chunked support for clisp (forwarded by Kevin M. Rosenberg from Debian) 2003-08-31 Rudi Schlatte * acl-compat.asd: Remove old cmu-read-sequence cruft, bug is fixed in reasonably recent cmucl * lw-buffering.lisp (stream-fill-buffer): Use package-external symbol that doesn't break on CVS cmucl 2003-08-30 Rudi Schlatte * cmucl/acl-socket.lisp (make-socket): set reuse-address option. * lw-buffering.lisp (stream-fill-buffer): Implement b/nb semantics for cmucl as well. client mode should now neither hang trying to read closed streams nor give spurious errors for slow servers. 2003-08-17 Rudi Schlatte * sbcl/acl-mp.lisp (with-timeout): Eliminate unused-variable warning. 2003-05-13 Rudi Schlatte * cmucl/acl-sys.lisp, cmucl/acl-socket.lisp, cmucl/acl-excl.lisp: Use correct package names in in-package forms (Reported by Johan Parin) * packages.lisp (acl-compat.system): Add nickname acl-compat.sys, remove commented-out nicknames. * lispworks/acl-sys.lisp: push MSWINDOWS onto *features* if appropriate (Thanks to Alain Picard for the report). 2003-05-11 Rudi Schlatte * acl-compat.asd: Don't load read-/write-sequence patches on cmucl 18e. 2003-05-06 Rudi Schlatte * lw-buffering.lisp (stream-fill-buffer): Implement blocking/non-blocking semantics (read at least one byte per fill-buffer call). Otherwise we'd get spurious EOFs with slow servers. * chunked-stream-mixin.lisp (gray-stream:stream-fill-buffer): Return a sensible value (amount of bytes that can be read before next call to fill-buffer). 2003-05-03 Rudi Schlatte * chunked-stream-mixin.lisp (gray-stream:stream-fill-buffer): Make input-chunking work, refactor somewhat to make all slot changes in one place. 2003-05-02 Rudi Schlatte * acl-compat.asd (acl-compat): Current cmucl versions handle Gray streams in (read,write)-sequence -- remove hack 2003-04-30 Rudi Schlatte * sbcl/acl-mp.lisp (with-timeout): Use timeout symbols from the ext package; latest cvs exports them * cmucl/acl-mp.lisp: Use acl-compat.mp package name. * acl-compat.asd et al: The Great Renaming: begin move of implementation-dependent files into subdirectories 2003-04-27 Rudi Schlatte * acl-socket-sbcl.lisp: Implemented peername lookup (by storing the socket in the plist of the bivalent stream object for now) 2003-04-26 Rudi Schlatte * acl-mp-sbcl.lisp: Add initial support for multi-threaded sbcl 2003-04-08 Rudi Schlatte * uri.lisp (render-uri): Reinstate with-output-to-string logic; render-uri has to handle nil as a stream value. 2003-04-03 Rudi Schlatte * uri.lisp (render-uri, print-object): Further frob printing of URIs, inspired by patch of Harley Gorrell 2003-04-02 Rudi Schlatte * uri.lisp (render-uri): Fix printing URIs in the presence of #\~ (Thanks to Harley Gorrell) 2003-03-24 Rudi Schlatte * lw-buffering.lisp (stream-write-buffer, stream-flush-buffer): Eliminate "wait" parameter to regain api-compatibility with lispworks (stream-finish-output, stream-force-output): Call (finish|force)-output here instead of using "wait" parameter of stream-flush-buffer * chunked-stream-mixin.lisp: some documentation added, formatting, eliminate use of "wait" parameter on stream-write-buffer etc. 2003-02-28 Rudi Schlatte * acl-socket-sbcl.lisp: (remote-host, remote-port, local-host, local-port): Change return value to something convertible to an (invalid) inet address * acl-compat.asd, packages.lisp: Support sbcl 0.7.13 single-threaded 2002-12-26 Rudi Schlatte * lw-buffering.lisp (write-elements): end argument value can be nil (fix contributed by Simon Andras 2002-12-24) * meta.lisp: Switch to new-style eval-when times * lw-buffering.lisp: Switch to new-style eval-when times (defstruct buffer-state): Add type declarations (stream-fill-buffer): Remove bug for non-cmucl case (need unblocking read-sequence) * chunked-stream-mixin.lisp: Add defgeneric forms * acl-socket-sbcl.lisp: Enable chunked transfer encoding support 2002-12-23 Rudi Schlatte * packages.lisp, acl-sys-sbcl.lisp: Various sbcl fixes 2002-12-18 Rudi Schlatte * packages.lisp: Add package definition of de.dataheaven.chunked-stream-mixin, remove nicknames for acl-compat.system 2002-12-17 Rudi Schlatte * (Module): Added first stab at sbcl support (some stub functions, basic page serving works) 2002-12-13 Rudi Schlatte * lw-buffering.lisp (stream-write-sequence): Make publish-multi work (provide default value for start arg). * acl-excl-cmu.lisp (write-vector): ditto. 2002-12-03 Rudi Schlatte * acl-compat.asd: load lw-buffering in every implementation except lispworks * packages.lisp: define gray-stream package for every implementation cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/README000066400000000000000000000024171133377100500227320ustar00rootroot00000000000000-*- text -*- acl-compat is a library that implements parts of the Allegro Common Lisp (ACL) API for areas that are not covered by the ANSI Common Lisp standard itself (e.g. sockets, threading). The motivation for creating and maintaining acl-compat is to get the web server AllegroServe (that was released by Franz Inc under the LLGPL) running on a wide range of Lisp implementations, with as few source changes to its core code as possible. acl-compat names its packages by prepending the corresponding ACL package name with the string "ACL-COMPAT.". For example, the ACL threading API symbols are exported from the package ACL-COMPAT.MP. Ideally, ACL-specific code could run on any supported Lisp implementation only by changing package references. Of course, the present situation is not ideal. :( Functionality is only implemented on an as-needed basis, implemented functions don't handle all argument combinations properly, etc. On the other hand, enough is implemented to support a web and application server that exercises a wide range of functionality (client and server sockets, threading, etc.). To load acl-compat: - install asdf (see < http://www.cliki.net/asdf >) and make sure it's loaded. - load acl-compat.asd - evaluate (asdf:operate 'asdf:load-op :acl-compat) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-compat-cmu.system000066400000000000000000000031131133377100500261140ustar00rootroot00000000000000;;; -*- mode: lisp -*- (in-package :CL-USER) ;; Stig: we're a debian-package if clc is present ;; Rudi: Not if kludge-no-cclan is also present #+(and common-lisp-controller (not kludge-no-cclan)) (setf (logical-pathname-translations "acl-compat") '(("**;*.*.*" "cl-library:;acl-compat;**;*.*.*"))) (mk:defsystem "ACL-COMPAT" :source-pathname (make-pathname :directory (pathname-directory *load-truename*)) ;"acl-compat:" ; :source-extension "lisp" ; :binary-pathname nil ; :binary-extension nil :components ((:file "nregex") (:file "packages" :depends-on ("nregex")) (:file "lw-buffering" :depends-on ("packages")) (:file "acl-mp-cmu" :depends-on ("packages")) (:file "acl-excl-cmu" :depends-on ("packages" "nregex")) (:file "cmu-read-sequence") (:file "acl-socket-cmu" :depends-on ("packages" "acl-excl-cmu" "chunked-stream-mixin" "cmu-read-sequence")) (:file "acl-sys-cmu" :depends-on ("packages")) (:file "meta") (:file "uri" :depends-on ("meta")) (:file "chunked-stream-mixin" :depends-on ("packages" "acl-excl-cmu" "lw-buffering"))) ;; Stig: if we're CMU and a debian-package, we need graystreams #+(and cmu common-lisp-controller) :depends-on #+(and cmu common-lisp-controller) (cmucl-graystream)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-compat-common-lisp-lw.lisp000066400000000000000000000015231133377100500276330ustar00rootroot00000000000000(defpackage acl-compat-common-lisp (:use common-lisp) (:shadow make-hash-table) (:export make-hash-table)) (in-package :acl-compat-common-lisp) (defun make-hash-table (&rest args &key test size rehash-size rehash-threshold (hash-function nil h-f-p) (values t) weak-keys) (declare (ignore hash-function)) (when h-f-p (error "User defined hash-functions are not supported.")) (let ((table (apply #'cl:make-hash-table :allow-other-keys t args))) (hcl:set-hash-table-weak table (if weak-keys (if (eq values :weak) :both :key) (if (eq values :weak) :value nil))) table))cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-compat-corman.lisp000066400000000000000000000012041133377100500262310ustar00rootroot00000000000000(require 'gray-streams) (in-package :cl-user) (defvar *acl-compat-directory* "d:/projects/lisp/portableaserve/acl-compat/") (load (concatenate 'string *acl-compat-directory* "nregex.lisp")) (load (concatenate 'string *acl-compat-directory* "meta.lisp")) (load (concatenate 'string *acl-compat-directory* "acl-excl-corman.lisp")) (load (concatenate 'string *acl-compat-directory* "acl-mp-corman.lisp")) (load (concatenate 'string *acl-compat-directory* "acl-socket-corman.lisp")) (load (concatenate 'string *acl-compat-directory* "uri.lisp")) (load (concatenate 'string *acl-compat-directory* "packages.lisp")) (pushnew :acl-compat *features*)cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-compat.asd000066400000000000000000000155321133377100500245650ustar00rootroot00000000000000;;;; -*- mode: lisp -*- ;;;; ;;;; This as an ASDF system for ACL-COMPAT, meant to replace ;;;; acl-compat-cmu.system, but could replace all other systems, too. ;;;; (hint, hint) (defpackage #:acl-compat-system (:use #:cl #:asdf)) (in-package #:acl-compat-system) ;;;; gray stream support for cmucl: Debian/common-lisp-controller has ;;;; a `cmucl-graystream' system; if this is not found, we assume a ;;;; cmucl downloaded from cons.org, where Gray stream support resides ;;;; in the subsystems/ directory. #+cmu (progn (defclass precompiled-file (static-file) ()) (defmethod perform ((operation load-op) (c precompiled-file)) (load (component-pathname c))) (defmethod operation-done-p ((operation load-op) (c precompiled-file)) nil) #-gray-streams (eval-when (:compile-toplevel :load-toplevel :execute) (unless (asdf:find-system :cmucl-graystream nil) (asdf:defsystem cmucl-graystream :pathname (make-pathname :name nil :type nil :version nil :defaults (truename "library:subsystems/gray-streams-library.x86f")) :components ((:precompiled-file "gray-streams-library.x86f"))))) ) ;;;; ignore warnings ;;;; ;;;; FIXME: should better fix warnings instead of ignoring them ;;;; FIXME: (perform legacy-cl-sourcefile) duplicates ASDF code (defclass legacy-cl-source-file (cl-source-file) () (:documentation "Common Lisp source code module with (non-style) warnings. In contrast to CL-SOURCE-FILE, this class does not think that such warnings indicate failure.")) (defmethod perform ((operation compile-op) (c legacy-cl-source-file)) (let ((source-file (component-pathname c)) (output-file (car (output-files operation c))) (warnings-p nil) (failure-p nil)) (setf (asdf::component-property c 'last-compiled) nil) (handler-bind ((warning (lambda (c) (declare (ignore c)) (setq warnings-p t))) ;; _not_ (or error (and warning (not style-warning))) (error (lambda (c) (declare (ignore c)) (setq failure-p t)))) (compile-file source-file :output-file output-file)) ;; rest of this method is as for CL-SOURCE-FILE (setf (asdf::component-property c 'last-compiled) (file-write-date output-file)) (when warnings-p (case (asdf::operation-on-warnings operation) (:warn (warn "COMPILE-FILE warned while performing ~A on ~A" c operation)) (:error (error 'compile-warned :component c :operation operation)) (:ignore nil))) (when failure-p (case (asdf::operation-on-failure operation) (:warn (warn "COMPILE-FILE failed while performing ~A on ~A" c operation)) (:error (error 'compile-failed :component c :operation operation)) (:ignore nil))))) ;;; ;;; This is thought to reduce reader-conditionals in the system definition ;;; (defclass unportable-cl-source-file (cl-source-file) () (:documentation "This is for files which contain lisp-system dependent code. Until now those are marked by a -system postfix but we could later change that to a directory per lisp-system")) (defmethod perform ((op load-op) (c unportable-cl-source-file)) (#+cmu ext:without-package-locks #-(or cmu) progn (call-next-method))) (defmethod perform ((op compile-op) (c unportable-cl-source-file)) (#+cmu ext:without-package-locks #-(or cmu) progn (call-next-method))) (defmethod source-file-type ((c unportable-cl-source-file) (s module)) "lisp") (defun lisp-system-shortname () #+allegro :allegro #+lispworks :lispworks #+cmu :cmucl #+(or mcl openmcl) :mcl #+clisp :clisp #+scl :scl #+sbcl :sbcl) ;mcl/openmcl use the same directory (defmethod component-pathname ((component unportable-cl-source-file)) (let ((pathname (call-next-method)) (name (string-downcase (lisp-system-shortname)))) (merge-pathnames (make-pathname :directory (list :relative name)) pathname))) ;;;; system #+(and mcl (not openmcl)) (require :ansi-make-load-form) (defsystem acl-compat :name "acl-compat" :author "The acl-compat team" :version "0.1.1" :description "A reimplementation of parts of the ACL API, mainly to get AllegroServe running on various machines, but might be useful in other projects as well." :properties ((("system" "author" "email") . "portableaserve-discuss@lists.sourceforge.net") (("albert" "presentation" "output-dir") . "docs/") (("albert" "presentation" "formats") . "docbook") (("albert" "docbook" "dtd") . "/Users/Shared/DocBook/lib/docbook/docbook-dtd-412/docbookx.dtd") (("albert" "docbook" "template") . "book")) :components ( ;; packages (:file "packages") ;; Our stream class; support for buffering, chunking and (in the ;; future) unified stream exceptions #-(or lispworks (and mcl (not openmcl))) (:file "lw-buffering" :depends-on ("packages")) #-(or allegro (and mcl (not openmcl))) (:legacy-cl-source-file "chunked-stream-mixin" :depends-on ("packages" "acl-excl" #-lispworks "lw-buffering")) ;; Multiprocessing #+(or mcl openmcl) (:unportable-cl-source-file "mcl-timers") (:unportable-cl-source-file "acl-mp" :depends-on ("packages" #+(or mcl openmcl) "mcl-timers")) ;; Sockets, networking; TODO: de-frob this a bit #-(or mcl openmcl) (:unportable-cl-source-file "acl-socket" :depends-on ("packages" "acl-excl" #-(or allegro (and mcl (not openmcl))) "chunked-stream-mixin")) #+(and mcl (not openmcl)) (:unportable-cl-source-file "acl-socket-mcl" :depends-on ("packages")) #+(and mcl (not openmcl) (not carbon-compat)) (:unportable-cl-source-file "mcl-stream-fix" :depends-on ("acl-socket-mcl")) #+openmcl (:unportable-cl-source-file "acl-socket-openmcl" :depends-on ("packages" "chunked-stream-mixin")) ;; Diverse macros, utility functions #-allegro (:file "acl-excl-common" :depends-on ("packages")) (:unportable-cl-source-file "acl-excl" :depends-on #-allegro ("acl-excl-common") #+allegro ("packages")) (:unportable-cl-source-file "acl-sys" :depends-on ("packages")) ;; SSL #+(and ssl-available (not (or allegro mcl openmcl clisp))) (:file "acl-ssl" :depends-on ("acl-ssl-streams" "acl-socket")) #+(and ssl-available (not (or allegro mcl openmcl clisp))) (:file "acl-ssl-streams" :depends-on ("packages"))) ;; Dependencies :depends-on (:puri :cl-ppcre #+sbcl :sb-bsd-sockets #+sbcl :sb-posix #+(and cmu (not gray-streams)) :cmucl-graystream #+(and (or cmu lispworks) ssl-available) :cl-ssl ) :perform (load-op :after (op acl-compat) (pushnew :acl-compat cl:*features*))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-excl-common.lisp000066400000000000000000000163401133377100500257210ustar00rootroot00000000000000;;;; ;;;; ACL-COMPAT - EXCL ;;;; ;;;; This is a modified version of Chris Doubles ACL excl wrapper library ;;;; As stated in the changelogs of his original this file includes the ;;;; IF* macro placed in the public domain by John Foderaro. ;;;; See: http://www.franz.com/~jkf/ifstar.txt ;;;; ;;;; This file was made by Rudi Schlatte to gather ;;;; not-implementation-specific parts of acl-compat in one place. ;;;; This is the header of Chris Doubles original file. (but without Changelog) ;;;; ;;;; ACL excl wrapper library for Corman Lisp - Version 1.1 ;;;; ;;;; Copyright (C) 2000 Christopher Double. All Rights Reserved. ;;;; ;;;; License ;;;; ======= ;;;; This software is provided 'as-is', without any express or implied ;;;; warranty. In no event will the author be held liable for any damages ;;;; arising from the use of this software. ;;;; ;;;; Permission is granted to anyone to use this software for any purpose, ;;;; including commercial applications, and to alter it and redistribute ;;;; it freely, subject to the following restrictions: ;;;; ;;;; 1. The origin of this software must not be misrepresented; you must ;;;; not claim that you wrote the original software. If you use this ;;;; software in a product, an acknowledgment in the product documentation ;;;; would be appreciated but is not required. ;;;; ;;;; 2. Altered source versions must be plainly marked as such, and must ;;;; not be misrepresented as being the original software. ;;;; ;;;; 3. This notice may not be removed or altered from any source ;;;; distribution. ;;;; (in-package :acl-compat.excl) (defvar if*-keyword-list '("then" "thenret" "else" "elseif")) ;this is not used in aserve, but is needed to use the franz xmlutils package with acl-compat (defvar *current-case-mode* :case-insensitive-upper) (defmacro if* (&rest args) (do ((xx (reverse args) (cdr xx)) (state :init) (elseseen nil) (totalcol nil) (lookat nil nil) (col nil)) ((null xx) (cond ((eq state :compl) `(cond ,@totalcol)) (t (error "if*: illegal form ~s" args)))) (cond ((and (symbolp (car xx)) (member (symbol-name (car xx)) if*-keyword-list :test #'string-equal)) (setq lookat (symbol-name (car xx))))) (cond ((eq state :init) (cond (lookat (cond ((string-equal lookat "thenret") (setq col nil state :then)) (t (error "if*: bad keyword ~a" lookat)))) (t (setq state :col col nil) (push (car xx) col)))) ((eq state :col) (cond (lookat (cond ((string-equal lookat "else") (cond (elseseen (error "if*: multiples elses"))) (setq elseseen t) (setq state :init) (push `(t ,@col) totalcol)) ((string-equal lookat "then") (setq state :then)) (t (error "if*: bad keyword ~s" lookat)))) (t (push (car xx) col)))) ((eq state :then) (cond (lookat (error "if*: keyword ~s at the wrong place " (car xx))) (t (setq state :compl) (push `(,(car xx) ,@col) totalcol)))) ((eq state :compl) (cond ((not (string-equal lookat "elseif")) (error "if*: missing elseif clause "))) (setq state :init))))) (defvar *initial-terminal-io* *terminal-io*) (defvar *cl-default-special-bindings* nil) (defun filesys-size (stream) (file-length stream)) (defun filesys-write-date (stream) (file-write-date stream)) (defun frob-regexp (regexp) "This converts from ACL regexps to Perl regexps. The escape status of (, ) and | is toggled." (let ((escapees '(#\) #\( #\| ))) (with-input-from-string (in regexp) (with-output-to-string (out) (loop for c = (read-char in nil nil nil) while c do (cond ((and (char= c #\\) (member (peek-char nil in nil nil nil) escapees)) (setf c (read-char in))) ((member c escapees) (princ #\\ out))) (princ c out)))))) ;; TODO: a compiler macro for constant string regexps would be nice, ;; so that the create-scanner call at runtime can be evaded. (defun match-regexp (string-or-regexp string-to-match &key newlines-special case-fold return (start 0) end shortest) "Note: if a regexp compiled with compile-regexp is passed, the options newlines-special and case-fold shouldn't be used, since the underlying engine uses them when generating the scanner, not when executing it." (when shortest (error "match-regexp: shortest option not supported yet.")) (unless end (setf end (length string-to-match))) (let ((scanner (cl-ppcre:create-scanner (frob-regexp string-or-regexp) :case-insensitive-mode case-fold :single-line-mode newlines-special))) (ecase return (:string ; return t, list of strings (multiple-value-bind (match regs) (cl-ppcre:scan-to-strings scanner string-to-match :start start :end end) (if match (apply #'values t match (coerce regs 'list)) nil))) (:index ; return (cons start end) (multiple-value-bind (start end reg-starts reg-ends) (cl-ppcre:scan scanner string-to-match :start start :end end) (and start (apply #'values t (cons start end) (map 'list #'cons reg-starts reg-ends))))) ((nil) ; return t (not (not (cl-ppcre:scan scanner string-to-match :start start :end end))))))) ;; Caution Incompatible APIs! cl-ppcre has options case-insensitive, ;; single-line for create-scanner, ACL has it in match-regexp. (defun compile-regexp (regexp) "Note: Take care when using scanners compiled with this option to not depend on options case-fold and newlines-special in match-regexp." (cl-ppcre:create-scanner (frob-regexp regexp))) (defvar *current-case-mode* :case-insensitive-upper) (defun intern* (s len package) (intern (subseq s 0 len) package)) (defmacro errorset (form &optional (announce nil) (catch-breaks nil)) "This macro is incomplete. It was hacked to get AllegroServe running, but the announce and catch-breaks arguments are ignored. See documentation at http://franz.com/support/documentation/6.1/doc/pages/operators/excl/errorset.htm An implementation of the catch-breaks argument will necessarily be implementation-dependent, since Ansi does not allow any program-controlled interception of a break." (declare (ignore announce catch-breaks)) `(let* ((ok nil) (results (ignore-errors (prog1 (multiple-value-list ,form) (setq ok t))))) (if ok (apply #'values t results) nil))) (defmacro fast (&body forms) `(locally (declare (optimize (speed 3) (safety 0) (debug 0))) ,@forms)) #-cmu (defun write-vector (sequence stream &key (start 0) end endian-swap) (declare (ignore endian-swap)) (check-type sequence (or string (array (unsigned-byte 8) 1) (array (signed-byte 8) 1))) (write-sequence sequence stream :start start :end end)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-excl-corman.lisp000066400000000000000000000154571133377100500257200ustar00rootroot00000000000000;;;; ;;;; ACL-COMPAT - EXCL ;;;; ;;;; This is a modified version of Chris Doubles ACL excl wrapper library ;;;; As stated in the changelogs of his original this file includes the ;;;; IF* macro placed in the public domain by John Foderaro. ;;;; See: http://www.franz.com/~jkf/ifstar.txt ;;;; ;;;; It is not clear to this point if future releases will lead to a combined ;;;; effort - So you may find newer versions of *this* file at ;;;; http://www.dataheaven.de ;;;; ;;;; This is the header of Chris Doubles original file. (but without Changelog) ;;;; ;;;; ACL excl wrapper library for Corman Lisp - Version 1.1 ;;;; ;;;; Copyright (C) 2000 Christopher Double. All Rights Reserved. ;;;; ;;;; License ;;;; ======= ;;;; This software is provided 'as-is', without any express or implied ;;;; warranty. In no event will the author be held liable for any damages ;;;; arising from the use of this software. ;;;; ;;;; Permission is granted to anyone to use this software for any purpose, ;;;; including commercial applications, and to alter it and redistribute ;;;; it freely, subject to the following restrictions: ;;;; ;;;; 1. The origin of this software must not be misrepresented; you must ;;;; not claim that you wrote the original software. If you use this ;;;; software in a product, an acknowledgment in the product documentation ;;;; would be appreciated but is not required. ;;;; ;;;; 2. Altered source versions must be plainly marked as such, and must ;;;; not be misrepresented as being the original software. ;;;; ;;;; 3. This notice may not be removed or altered from any source ;;;; distribution. ;;;; ;;;; Notes ;;;; ===== ;;;; A simple implementation of some of the EXCL package from Allegro ;;;; Common Lisp. Intended to be used for porting various ACL packages, ;;;; like AllegroServe. ;;;; ;;;; More recent versions of this software may be available at: ;;;; http://www.double.co.nz/cl ;;;; ;;;; Comments, suggestions and bug reports to the author, ;;;; Christopher Double, at: chris@double.co.nz (require 'nregex) (require 'mp) (defpackage :excl (:use :common-lisp :nregex) (:import-from :common-lisp "FIXNUMP") (:export "IF*" "*INITIAL-TERMINAL-IO*" "*CL-DEFAULT-SPECIAL-BINDINGS*" "FILESYS-SIZE" "FILESYS-WRITE-DATE" "STREAM-INPUT-FN" "MATCH-REGEXP" "COMPILE-REGEXP" "*CURRENT-CASE-MODE*" "INTERN*" "FILESYS-TYPE" "ERRORSET" "ATOMICALLY" "FAST" "WITHOUT-PACKAGE-LOCKS" "SOCKET-ERROR" "RUN-SHELL-COMMAND" "FIXNUMP" )) (in-package :excl) (defvar if*-keyword-list '("then" "thenret" "else" "elseif")) (defmacro if* (&rest args) (do ((xx (reverse args) (cdr xx)) (state :init) (elseseen nil) (totalcol nil) (lookat nil nil) (col nil)) ((null xx) (cond ((eq state :compl) `(cond ,@totalcol)) (t (error "if*: illegal form ~s" args)))) (cond ((and (symbolp (car xx)) (member (symbol-name (car xx)) if*-keyword-list :test #'string-equal)) (setq lookat (symbol-name (car xx))))) (cond ((eq state :init) (cond (lookat (cond ((string-equal lookat "thenret") (setq col nil state :then)) (t (error "if*: bad keyword ~a" lookat)))) (t (setq state :col col nil) (push (car xx) col)))) ((eq state :col) (cond (lookat (cond ((string-equal lookat "else") (cond (elseseen (error "if*: multiples elses"))) (setq elseseen t) (setq state :init) (push `(t ,@col) totalcol)) ((string-equal lookat "then") (setq state :then)) (t (error "if*: bad keyword ~s" lookat)))) (t (push (car xx) col)))) ((eq state :then) (cond (lookat (error "if*: keyword ~s at the wrong place " (car xx))) (t (setq state :compl) (push `(,(car xx) ,@col) totalcol)))) ((eq state :compl) (cond ((not (string-equal lookat "elseif")) (error "if*: missing elseif clause "))) (setq state :init))))) (defvar *initial-terminal-io* *terminal-io*) (defvar *cl-default-special-bindings* nil) (defun filesys-size (stream) (file-length stream)) (defun filesys-write-date (stream) (file-write-date stream)) #+obsolete (defun stream-input-fn (stream) stream) (defmethod stream-input-fn ((stream stream)) stream) (defun match-regexp (pattern string &key (return :string)) (let ((res (cond ((stringp pattern) (regex pattern string)) ((functionp pattern) (funcall pattern string)) (t (error "Wrong type for pattern"))))) (case return (:string (values-list (cons (not (null res)) res))) (:index (error "REGEXP: INDEX Not implemented")) (otherwise (not (null res)))))) (defun compile-regexp (regexp) (compile nil (regex-compile regexp))) (defvar *current-case-mode* :case-insensitive-upper) (defun intern* (s len package) (intern (subseq s 0 len) package)) (defun filesys-type (file-or-directory-name) (if (ccl::directory-p file-or-directory-name) :directory (if (probe-file file-or-directory-name) :file nil))) (defmacro errorset (form &optional (announce nil) (catch-breaks nil)) "This macro is incomplete. It was hacked to get AllegroServe running, but the announce and catch-breaks arguments are ignored. See documentation at http://franz.com/support/documentation/6.1/doc/pages/operators/excl/errorset.htm An implementation of the catch-breaks argument will necessarily be implementation-dependent, since Ansi does not allow any program-controlled interception of a break." (declare (ignore announce catch-breaks)) `(let* ((ok nil) (results (ignore-errors (prog1 (multiple-value-list ,form) (setq ok t))))) (if ok (apply #'values t results) nil))) (defmacro atomically (&body forms) `(mp:without-scheduling ,@forms)) (defmacro fast (&body forms) `(locally (declare (optimize (speed 3) (safety 0) (debug 0))) ,@forms)) (defmacro without-package-locks (&body forms) `(progn ,@forms)) (define-condition socket-error (error) ((stream :initarg :stream) (code :initarg :code :initform nil) (action :initarg :action) (identifier :initarg :identifier :initform nil)) (:report (lambda (e s) (with-slots (identifier code action stream) e (format s "~S (errno ~A) occured while ~A" (case identifier (:connection-refused "Connection refused") (t identifier)) code action) (when stream (prin1 stream s)) (format s "."))))) #| (defun run-shell-command () (with-open-stream (s (open-pipe "/bin/sh" :direction :io :buffered nil)) (loop for var in environment do (format stream "~A=~A~%" (car var) (cdr var))) |# (provide 'acl-excl) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-mp-corman.lisp000066400000000000000000000030451133377100500253670ustar00rootroot00000000000000;;; This file implements the process functions for AllegroServe in Corman Lisp. (require 'mp) (defpackage :acl-compat-mp (:use :common-lisp :mp :sys) (:export #:process-interrrupt #:make-process #:make-process-lock #:process-add-run-reason #:process-kill #:process-property-list #:process-revoke-run-reason #:process-run-function #:with-process-lock #:with-timeout #:without-scheduling #:*current-process* #:lock #:process-allow-schedule #:process-name #:process-preset #:process-run-reasons #:process-wait #:without-interrupts )) (in-package :acl-compat-mp) ; existing stuff from ccl we can reuse directly ;; The following process-property-list implementation was taken from ;; the acl-mp-scl.lisp implementation. (defvar *process-plists* (make-hash-table :test #'eq) "maps processes to their plists. See the functions process-plist, (setf process-plist).") (defun process-property-list (process) (gethash process *process-plists*)) (defun (setf process-property-list) (new-value process) (setf (gethash process *process-plists*) new-value)) ;; Dummy implementation of process-wait (defun process-wait (whostate function &rest args) "This function suspends the current process (the value of sys:*current-process*) until applying function to arguments yields true. The whostate argument must be a string which temporarily replaces the process' whostate for the duration of the wait. This function returns nil." (loop until (apply function args) do (sleep 0)) nil) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-mp-package.lisp000066400000000000000000000053231133377100500255040ustar00rootroot00000000000000;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: CL-USER; -*- ;;;; ; ;;;; (c) 2001 by Jochen Schmidt. ;;;; ;;;; File: acl-mp-package.lisp ;;;; Revision: 1.0.0 ;;;; Description: Package definition for ACL-COMPAT-MP ;;;; Date: 02.02.2002 ;;;; Authors: Jochen Schmidt ;;;; Tel: (+49 9 11) 47 20 603 ;;;; Email: jsc@dataheaven.de ;;;; ;;;; Redistribution and use in source and binary forms, with or without ;;;; modification, are permitted provided that the following conditions ;;;; are met: ;;;; 1. Redistributions of source code must retain the above copyright ;;;; notice, this list of conditions and the following disclaimer. ;;;; 2. Redistributions in binary form must reproduce the above copyright ;;;; notice, this list of conditions and the following disclaimer in the ;;;; documentation and/or other materials provided with the distribution. ;;;; ;;;; THIS SOFTWARE IS PROVIDED "AS IS" AND THERE ARE NEITHER ;;;; EXPRESSED NOR IMPLIED WARRANTIES - THIS INCLUDES, BUT ;;;; IS NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY ;;;; AND FITNESS FOR A PARTICULAR PURPOSE.IN NO WAY ARE THE ;;;; AUTHORS LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ;;;; SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ;;;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES ; ;;;; LOSS OF USE, DATA, OR PROFITS ; OR BUSINESS INTERRUPTION) ;;;; ;;;; For further details contact the authors of this software. ;;;; ;;;; Jochen Schmidt ;;;; Zuckmantelstr. 11 ;;;; 91616 Neusitz ;;;; GERMANY ;;;; ;;;; (defpackage :acl-compat-mp (:use :common-lisp) (:export #:*current-process* ;* #:process-kill ;* #:process-preset ;* #:process-name ;* #:process-wait-function #:process-run-reasons #:process-arrest-reasons #:process-whostate #:without-interrupts #:process-wait #:process-enable #:process-disable #:process-reset #:process-interrupt #:process-run-function ;* #:process-property-list ;* #:without-scheduling ;* #:process-allow-schedule ;* #:make-process ;* #:process-add-run-reason ;* #:process-revoke-run-reason ;* #:process-add-arrest-reason ;* #:process-revoke-arrest-reason ;* #:process-allow-schedule ;* #:with-timeout ;* #:make-process-lock ;* #:with-process-lock ;* #:process-active-p ; required by webactions #:current-process #:process-name-to-process #:process-wait-with-timeout #:wait-for-input-available ) (:nicknames :acl-mp)) ;; * marked ones are used in Portable Allegroserve cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-socket-corman.lisp000066400000000000000000000144151133377100500262460ustar00rootroot00000000000000;;;; ACL socket wrapper library for Corman Lisp - Version 1.1 ;;;; ;;;; Copyright (C) 2000 Christopher Double. All Rights Reserved. ;;;; ;;;; License ;;;; ======= ;;;; This software is provided 'as-is', without any express or implied ;;;; warranty. In no event will the author be held liable for any damages ;;;; arising from the use of this software. ;;;; ;;;; Permission is granted to anyone to use this software for any purpose, ;;;; including commercial applications, and to alter it and redistribute ;;;; it freely, subject to the following restrictions: ;;;; ;;;; 1. The origin of this software must not be misrepresented; you must ;;;; not claim that you wrote the original software. If you use this ;;;; software in a product, an acknowledgment in the product documentation ;;;; would be appreciated but is not required. ;;;; ;;;; 2. Altered source versions must be plainly marked as such, and must ;;;; not be misrepresented as being the original software. ;;;; ;;;; 3. This notice may not be removed or altered from any source ;;;; distribution. ;;;; ;;;; Notes ;;;; ===== ;;;; A simple wrapper around the SOCKETS package to present an interface ;;;; similar to the Allegro Common Lisp SOCKET package. Based on a package ;;;; by David Bakhash for LispWorks. For documentation on the ACL SOCKET ;;;; package see: ;;;; ;;;; http://www.franz.com/support/documentation/5.0.1/doc/cl/socket.htm ;;;; ;;;; More recent versions of this software may be available at: ;;;; http://www.double.co.nz/cl ;;;; ;;;; Comments, suggestions and bug reports to the author, ;;;; Christopher Double, at: chris@double.co.nz ;;;; ;;;; 17/09/2000 - 1.0 ;;;; Initial release. ;;;; ;;;; 20/09/2000 - 1.1 ;;;; Added SOCKET-CONTROL function. ;;;; ;;;; 27/02/2001 - 1.2 ;;;; Added ability to create SSL sockets. Doesn't use ;;;; same interface as Allegro 6 - need to look into ;;;; how that works. ;;;; ;;;; 03/01/2003 - 1.3 ;;;; Added to PortableAllegroServe. (eval-when (:compile-toplevel :load-toplevel :execute) (require :sockets) (require :ssl-sockets)) (sockets:start-sockets) (ssl-sockets:start-ssl-sockets) (defpackage socket (:use "COMMON-LISP") (:export "MAKE-SOCKET" "ACCEPT-CONNECTION" "DOTTED-TO-IPADDR" "IPADDR-TO-DOTTED" "IPADDR-TO-HOSTNAME" "LOOKUP-HOSTNAME" "REMOTE-HOST" "LOCAL-HOST" "LOCAL-PORT" "SOCKET-CONTROL" )) (in-package :socket) (defmethod accept-connection ((server-socket sockets::server-socket) &key (wait t)) (unless wait (error "WAIT keyword to ACCEPT-CONNECTION not implemented.")) (sockets:make-socket-stream (sockets:accept-socket server-socket))) (defun make-socket (&key (remote-host "0.0.0.0") ;;localhost? type local-port remote-port (connect :active) (format :text) ssl &allow-other-keys) (check-type remote-host string) (when (eq type :datagram) (error ":DATAGRAM keyword to MAKE-SOCKET not implemented.")) (when (eq format :binary) (warn ":BINARY keyword to MAKE-SOCKET partially implemented.")) (ecase connect (:passive (sockets:make-server-socket :host remote-host :port local-port)) (:active (sockets:make-socket-stream (if ssl (ssl-sockets:make-client-ssl-socket :host remote-host :port remote-port) (sockets:make-client-socket :host remote-host :port remote-port)))))) (defun dotted-to-ipaddr (dotted &key errorp) (when errorp (warn ":ERRORP keyword to DOTTED-TO-IPADDR not supported.")) (sockets:host-to-ipaddr dotted)) (defun ipaddr-to-dotted (ipaddr &key values) (when values (error ":VALUES keyword to IPADDR-TO-DOTTED not supported.")) (sockets:ipaddr-to-dotted ipaddr)) (defun ipaddr-to-hostname (ipaddr &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword to IPADDR-TO-HOSTNAME not supported.")) (sockets:ipaddr-to-name ipaddr)) (defun lookup-hostname (host &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword to IPADDR-TO-HOSTNAME not supported.")) (if (stringp host) (sockets:host-to-ipaddr host) (dotted-to-ipaddr (ipaddr-to-dotted host)))) (defun remote-host (socket-or-stream) (let ((socket (if (typep socket-or-stream 'sockets:base-socket) socket-or-stream (sockets:stream-socket-handle socket-or-stream)))) (sockets::remote-socket-ipaddr socket))) (defun local-host (socket-or-stream) (let ((socket (if (typep socket-or-stream 'sockets:base-socket) socket-or-stream (sockets:stream-socket-handle socket-or-stream)))) (if (not (typep socket 'sockets:local-socket)) 16777343 (sockets::socket-host-ipaddr socket)))) (defun local-port (socket-or-stream) (let ((socket (if (typep socket-or-stream 'sockets:base-socket) socket-or-stream (sockets:stream-socket-handle socket-or-stream)))) (sockets:socket-port socket))) (defun socket-control (stream &key output-chunking output-chunking-eof input-chunking) (declare (ignore stream output-chunking output-chunking-eof input-chunking)) (warn "SOCKET-CONTROL function not implemented.")) ;; Some workarounds to get combined text/binary socket streams working (defvar old-read-byte #'cl::read-byte) (defun new-read-byte (stream &optional (eof-error-p t) (eof-value nil)) "Replacement for Corman Lisp READ-BYTE to work with socket streams correctly." (if (eq (cl::stream-subclass stream) 'sockets::socket-stream) (char-int (read-char stream eof-error-p eof-value)) (funcall old-read-byte stream eof-error-p eof-value))) (setf (symbol-function 'common-lisp::read-byte) #'new-read-byte) (in-package :cl) (defun write-sequence (sequence stream &key start end) (let ((element-type (stream-element-type stream)) (start (if start start 0)) (end (if end end (length sequence)))) (if (eq element-type 'character) (do ((n start (+ n 1))) ((= n end)) (write-char (if (typep (elt sequence n) 'number) (ccl:int-char (elt sequence n)) (elt sequence n)) stream)) (do ((n start (+ n 1))) ((= n end)) (write-byte (elt sequence n) stream)))) ;; recoded to avoid LOOP, because it isn't loaded yet ;(loop for n from start below end do ; (write-char (elt sequence n) stream)) ;(loop for n from start below end do ; (write-byte (elt sequence n) stream)) (force-output stream)) (provide 'acl-socket) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-ssl-streams.lisp000066400000000000000000000267571133377100500257720ustar00rootroot00000000000000;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: CL-USER; -*- ;;; ;;; Filename: gray-streams-integration.lisp ;;; Author: Jochen Schmidt ;;; Description: Integrate ssl-sockets with the lisp ;;; stream system using gray-streams. ;;; (in-package :ssl) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Gray Streams integration ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defclass ssl-stream-mixin () ((ssl-socket :accessor ssl-socket :initarg :ssl-socket))) (defclass binary-ssl-stream (ssl-stream-mixin gray-stream:fundamental-binary-input-stream gray-stream:fundamental-binary-output-stream) ()) (defclass character-ssl-stream (ssl-stream-mixin gray-stream:fundamental-character-input-stream gray-stream:fundamental-character-output-stream) ()) (defmethod #-cormanlisp gray-stream::stream-element-type #+cormanlisp gray-stream::stream-stream-element-type ((socket-stream binary-ssl-stream)) '(unsigned-byte 8)) (defmethod #-cormanlisp gray-stream::stream-element-type #+cormanlisp gray-stream::stream-stream-element-type ((socket-stream character-ssl-stream)) 'character) (defmethod gray-stream:stream-line-column ((socket-stream character-ssl-stream)) nil) (defmethod gray-stream:stream-line-column ((socket-stream binary-ssl-stream)) nil) (defmethod gray-stream:stream-listen ((socket-stream ssl-stream-mixin)) (with-slots (ssl-socket) socket-stream (> (ssl-internal:ssl-pending (ssl-internal:ssl-socket-handle ssl-socket)) 0))) (defmethod gray-stream:stream-read-byte ((socket-stream binary-ssl-stream)) (with-slots (ssl-socket) socket-stream (ssl-internal:ssl-socket-read-byte ssl-socket))) (defmethod gray-stream:stream-write-byte ((socket-stream binary-ssl-stream) byte) (with-slots (ssl-socket) socket-stream (ssl-internal:ssl-socket-write-byte byte ssl-socket))) #| (defmethod gray-stream:stream-read-char ((socket-stream character-ssl-stream)) (with-slots (ssl-socket) socket-stream (ssl-internal:ssl-socket-read-char ssl-socket))) (defmethod gray-stream:stream-read-char ((socket-stream binary-ssl-stream)) (with-slots (ssl-socket) socket-stream (ssl-internal:ssl-socket-read-char ssl-socket))) |# ; Bivalent (defmethod gray-stream:stream-read-char ((socket-stream ssl-stream-mixin)) (with-slots (ssl-socket) socket-stream (ssl-internal:ssl-socket-read-char ssl-socket))) (defmethod gray-stream:stream-read-char-no-hang ((socket-stream character-ssl-stream)) (when (listen socket-stream) (with-slots (ssl-socket) socket-stream (ssl-internal:ssl-socket-read-char ssl-socket)))) #| (defmethod gray-stream:stream-write-char ((socket-stream character-ssl-stream) char) (with-slots (ssl-socket) socket-stream (ssl-internal:ssl-socket-write-char char ssl-socket))) (defmethod gray-stream:stream-write-char ((socket-stream binary-ssl-stream) char) (with-slots (ssl-socket) socket-stream (ssl-internal:ssl-socket-write-char char ssl-socket))) |# ; Bivalent (defmethod gray-stream:stream-write-char ((socket-stream ssl-stream-mixin) char) (with-slots (ssl-socket) socket-stream (ssl-internal:ssl-socket-write-char char ssl-socket))) ; Bivalent (defmethod gray-stream:stream-force-output ((socket-stream ssl-stream-mixin)) (with-slots (ssl-socket) socket-stream (ssl-internal:flush-output-buffer ssl-socket))) (defmethod gray-stream:stream-finish-output ((socket-stream ssl-stream-mixin)) (with-slots (ssl-socket) socket-stream (ssl-internal:flush-output-buffer ssl-socket))) (defmethod gray-stream:stream-clear-output ((socket-stream ssl-stream-mixin)) (with-slots (ssl-socket) socket-stream (with-slots (ssl-internal::output-offset) ssl-socket (setf ssl-internal::output-offset 0)))) (defmethod gray-stream:stream-clear-input ((socket-stream ssl-stream-mixin)) (with-slots (ssl-socket) socket-stream (with-slots (ssl-internal::input-avail ssl-internal::input-offset) ssl-socket (setf ssl-internal::input-avail 0) (setf ssl-internal::input-offset 0)))) (defmethod #-cormanlisp common-lisp:close #+cormanlisp gray-stream:stream-close ((socket-stream ssl-stream-mixin) &key abort) (with-slots (ssl-socket) socket-stream (unless abort (ssl-internal:flush-output-buffer ssl-socket)) (ssl-internal:close-ssl-socket ssl-socket))) #| (defmethod gray-stream:stream-force-output ((socket-stream character-ssl-stream)) (with-slots (ssl-socket) socket-stream (ssl-internal:flush-output-buffer ssl-socket))) (defmethod gray-stream:stream-finish-output ((socket-stream character-ssl-stream)) (with-slots (ssl-socket) socket-stream (ssl-internal:flush-output-buffer ssl-socket))) (defmethod gray-stream:stream-clear-output ((socket-stream character-ssl-stream)) (with-slots (ssl-socket) socket-stream (with-slots (ssl-internal::output-offset) ssl-socket (setf ssl-internal::output-offset 0)))) (defmethod gray-stream:stream-clear-input ((socket-stream character-ssl-stream)) (with-slots (ssl-socket) socket-stream (with-slots (ssl-internal::input-avail ssl-internal::input-offset) ssl-socket (setf ssl-internal::input-avail 0) (setf ssl-internal::input-offset 0)))) (defmethod gray-stream:stream-read-sequence ((socket-stream character-ssl-stream) sequence start end) (let* ((len (length sequence)) (chars (- (min (or end len) len) start))) ;(format t "Read ~A chars from index ~A on.~%" chars start) (force-output t) (loop for i upfrom start repeat chars for char = (progn ;(format t "Read char on index ~A~%" i) ;(force-output t) (let ((c (gray-streams:stream-read-char socket-stream))) ;(format t "The element read was ~A~%" c) c)) if (eq char :eof) do (progn ;(format t "premature return on index ~A~%" i) ;(force-output t) (return-from gray-streams:stream-read-sequence i)) do (setf (elt sequence i) char)) ;(format t "Normal return on index ~A~%" (+ start chars)) (force-output t) (+ start chars))) |# ;; ;; Why this argument ordering in CMUCL? LW has (stream sequence start end) ;; It would be interesting to know why it is a particular good idea to ;; reinvent APIs every second day in an incompatible way.... *grrr* ;; #+cmu (defmethod gray-stream:stream-read-sequence ((socket-stream character-ssl-stream) (sequence sequence) &optional start end) (let* ((len (length sequence)) (chars (- (min (or end len) len) start))) (loop for i upfrom start repeat chars for char = (gray-stream:stream-read-char socket-stream) if (eq char :eof) do (return-from gray-stream:stream-read-sequence i) do (setf (elt sequence i) char)) (+ start chars))) #+cmu (defmethod gray-stream:stream-read-sequence ((socket-stream binary-ssl-stream) (sequence sequence) &optional start end) (let* ((len (length sequence)) (chars (- (min (or end len) len) start))) (loop for i upfrom start repeat chars for char = (gray-stream:stream-read-byte socket-stream) if (eq char :eof) do (return-from gray-stream:stream-read-sequence i) do (setf (elt sequence i) char)) (+ start chars))) #| (defmethod gray-stream:stream-read-sequence ((socket-stream binary-ssl-stream) sequence start end) (let* ((len (length sequence)) (chars (- (min (or end len) len) start))) ;(format t "Read ~A chars from index ~A on.~%" chars start) (force-output t) (loop for i upfrom start repeat chars for char = (progn ;(format t "Read char on index ~A~%" i) ;(force-output t) (let ((c (gray-streams:stream-read-byte socket-stream))) ;(format t "The element read was ~A~%" c) c)) if (eq char :eof) do (progn ;(format t "premature return on index ~A~%" i) ;(force-output t) (return-from gray-streams:stream-read-sequence i)) do (setf (elt sequence i) char)) ;(format t "Normal return on index ~A~%" (+ start chars)) (force-output t) (+ start chars))) |# #| Alternative implementation? (defmethod stream:stream-read-sequence ((socket-stream character-ssl-stream) sequence start end) (let* ((len (length sequence)) (chars (- (min (or end len) len) start))) (format t "Read ~A chars from index ~A on.~%" chars start) (force-output t) (loop for i upfrom start repeat chars for char = (progn (format t "Read char on index ~A~%" i) (force-output t) (let ((c (stream:stream-read-char socket-stream))) (format t "The element read was ~A~%" c) c)) if (eq char :eof) do (progn (format t "premature return on index ~A~%" i) (force-output t) (return-from stream:stream-read-sequence i)) do (setf (elt sequence i) char)) (format t "Normal return on index ~A~%" (+ start chars)) (force-output t) (+ start chars))) |# #| (defmethod common-lisp:close ((socket-stream character-ssl-stream) &key abort) (with-slots (ssl-socket) socket-stream (unless abort (ssl-internal:flush-output-buffer ssl-socket)) (ssl-internal:close-ssl-socket ssl-socket))) |# #+lispworks (declaim (inline %reader-function-for-sequence)) #+lispworks (defun %reader-function-for-sequence (sequence) (typecase sequence (string #'read-char) ((array unsigned-byte (*)) #'read-byte) ((array signed-byte (*)) #'read-byte) (otherwise #'read-byte))) #+lispworks (declaim (inline %writer-function-for-sequence)) #+lispworks (defun %writer-function-for-sequence (sequence) (typecase sequence (string #'write-char) ((array unsigned-byte (*)) #'write-byte) ((array signed-byte (*)) #'write-byte) (otherwise #'write-byte))) ;; Bivalent socket support for READ-SEQUENCE / WRITE-SEQUENCE #+lispworks (defmethod gray-stream:stream-read-sequence ((stream ssl-stream-mixin) sequence start end) (stream::read-elements stream sequence start end (%reader-function-for-sequence sequence))) #+lispworks (defmethod gray-stream:stream-write-sequence ((stream ssl-stream-mixin) sequence start end) (stream::write-elements stream sequence start end (typecase sequence (string t) ((array unsigned-byte (*)) nil) ((array signed-byte (*)) nil) (otherwise nil)))) #+lispworks (in-package :acl-socket) #+lispworks (defmethod remote-host ((socket ssl::ssl-stream-mixin)) (comm:get-socket-peer-address (ssl-internal::ssl-socket-fd (ssl::ssl-socket socket)))) #+lispworks (defmethod remote-port ((socket ssl::ssl-stream-mixin)) (multiple-value-bind (host port) (comm:get-socket-peer-address (ssl-internal::ssl-socket-fd (ssl::ssl-socket socket))) (declare (ignore host)) port)) #+lispworks (defmethod local-host ((socket ssl::ssl-stream-mixin)) (multiple-value-bind (host port) (comm:get-socket-address (ssl-internal::ssl-socket-fd (ssl::ssl-socket socket))) (declare (ignore port)) host)) #+lispworks (defmethod local-port ((socket ssl::ssl-stream-mixin)) (multiple-value-bind (host port) (comm:get-socket-address (ssl-internal::ssl-socket-fd (ssl::ssl-socket socket))) (declare (ignore host)) port)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/acl-ssl.lisp000066400000000000000000000050201133377100500242720ustar00rootroot00000000000000(in-package :ssl) ;;;;;;;;;;;;;;;;;;;;; ;;; ACL style API ;;; ;;;;;;;;;;;;;;;;;;;;; (defmethod make-ssl-client-stream ((socket integer) &rest options) (destructuring-bind (&key (format :binary)) options (when (minusp socket) (error "not a proper socket descriptor")) (let ((ssl-socket (make-instance 'ssl-internal:ssl-client-socket :fd socket))) (case format (:binary (make-instance 'binary-ssl-stream :ssl-socket ssl-socket)) (:text (make-instance 'character-ssl-stream :ssl-socket ssl-socket)) (otherwise (error "Unknown ssl-stream format")))))) #+lispworks (defmethod make-ssl-client-stream ((lw-socket-stream comm:socket-stream) &rest options) (apply #'make-ssl-client-stream (comm:socket-stream-socket lw-socket-stream) options)) #+cormanlisp (defmethod make-ssl-client-stream (stream &rest options) (apply #'make-ssl-client-stream (sockets:socket-descriptor (cl::stream-handle stream)) options)) (defmethod make-ssl-server-stream ((socket integer) &rest options) (destructuring-bind (&key certificate key other-certificates (format :binary)) options (when (minusp socket) (error "not a proper socket descriptor")) (let ((ssl-socket (make-instance 'ssl-internal:ssl-server-socket :fd socket :rsa-privatekey-file (or key certificate) :certificate-file (or certificate key)))) (case format (:binary (make-instance 'binary-ssl-stream :ssl-socket ssl-socket)) (:text (make-instance 'character-ssl-stream :ssl-socket ssl-socket)) (otherwise (error "Unknown ssl-stream format")))))) (defmethod make-ssl-server-stream ((socket ssl-stream-mixin) &rest options) (warn "SSL socket ~A reused" socket) socket) #+lispworks (defmethod make-ssl-server-stream ((lw-socket-stream comm:socket-stream) &rest options) (apply #'make-ssl-server-stream (comm:socket-stream-socket lw-socket-stream) options)) #+ignore (defmethod make-ssl-server-stream ((acl-socket acl-socket::server-socket) &rest options) (apply #'make-ssl-server-stream (comm::get-fd-from-socket (acl-socket::passive-socket acl-socket)) options)) #+ignore (defmethod make-ssl-server-stream ((lw-socket-stream acl-socket::chunked-socket-stream) &rest options) (apply #'make-ssl-server-stream (comm:socket-stream-socket lw-socket-stream) options)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/allegro/000077500000000000000000000000001133377100500234735ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/allegro/acl-excl.lisp000066400000000000000000000000721133377100500260530ustar00rootroot00000000000000;;;; ACL-COMPAT - EXCL ;;;; ;;;; Nothing needs to be done cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/allegro/acl-mp.lisp000066400000000000000000000001451133377100500255350ustar00rootroot00000000000000;;; This file implements the process functions for AllegroServe in MCL. (in-package :acl-compat.mp) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/allegro/acl-socket.lisp000066400000000000000000000001121133377100500264030ustar00rootroot00000000000000;;; Allegro layer for ACL sockets. ;;; (in-package :acl-compat.socket) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/allegro/acl-sys.lisp000066400000000000000000000001411133377100500257330ustar00rootroot00000000000000;;; Allegro System Package Compatibility file ;;; Nothing to do (in-package :acl-compat.system) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/chunked-stream-mixin.lisp000066400000000000000000000314131133377100500267750ustar00rootroot00000000000000;;;; ; ;;;; (c) 2002 by Jochen Schmidt. ;;;; ;;;; File: chunked-stream-mixin.lisp ;;;; Revision: 0.1 ;;;; Description: ACL style HTTP1.1 I/O chunking ;;;; Date: 08.04.2002 ;;;; Authors: Jochen Schmidt ;;;; Tel: (+49 9 11) 47 20 603 ;;;; Email: jsc@dataheaven.de ;;;; ;;;; Redistribution and use in source and binary forms, with or without ;;;; modification, are permitted provided that the following conditions ;;;; are met: ;;;; 1. Redistributions of source code must retain the above copyright ;;;; notice, this list of conditions and the following disclaimer. ;;;; 2. Redistributions in binary form must reproduce the above copyright ;;;; notice, this list of conditions and the following disclaimer in the ;;;; documentation and/or other materials provided with the distribution. ;;;; ;;;; THIS SOFTWARE IS PROVIDED "AS IS" AND THERE ARE NEITHER ;;;; EXPRESSED NOR IMPLIED WARRANTIES - THIS INCLUDES, BUT ;;;; IS NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY ;;;; AND FITNESS FOR A PARTICULAR PURPOSE.IN NO WAY ARE THE ;;;; AUTHORS LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ;;;; SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ;;;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES ; ;;;; LOSS OF USE, DATA, OR PROFITS ; OR BUSINESS INTERRUPTION) ;;;; ;;;; For further details contact the authors of this software. ;;;; ;;;; Jochen Schmidt ;;;; Zuckmantelstr. 11 ;;;; 91616 Neusitz ;;;; GERMANY ;;;; ;;;; Nuernberg, 08.Apr.2002 Jochen Schmidt ;;;; (in-package :de.dataheaven.chunked-stream-mixin) (defun buffer-ref (buffer index) #+lispworks (schar buffer index) #-lispworks (aref buffer index)) (defun (setf buffer-ref) (new-value buffer index) #-lispworks (setf (aref buffer index) (char-code new-value)) #+lispworks (setf (schar buffer index) new-value)) (defclass chunked-stream-mixin () ((output-chunking-p :initform nil :accessor output-chunking-p) (chunk-input-avail :initform nil :documentation "Number of octets of the current chunk that are not yet read into the buffer, or nil if input chunking is disabled") (real-input-limit :initform 0 :documentation "Index of last octet read into buffer (input-limit points to index of last octet in the current chunk)"))) (defgeneric input-chunking-p (stream)) (defmethod input-chunking-p ((stream chunked-stream-mixin)) (not (null (slot-value stream 'chunk-input-avail)))) (defgeneric (setf input-chunking-p) (new-value stream)) (defmethod (setf input-chunking-p) (new-value (stream chunked-stream-mixin)) (setf (slot-value stream 'chunk-input-avail) (and new-value 0))) (define-condition acl-compat.excl::socket-chunking-end-of-file (condition) ((acl-compat.excl::format-arguments :initform nil :initarg :format-arguments) (acl-compat.excl::format-control :initform "A chunking end of file occured" :initarg :format-control))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Input chunking ;;; ;;;;;;;;;;;;;;;;;;;;;; ;; Input chunking is not tested so far! (defgeneric initialize-input-chunking (stream)) (defmethod initialize-input-chunking ((stream chunked-stream-mixin)) "This method initializes input chunking. The real-input-limit is nil in the beginnings because it got not saved yet. Chunk-input-avail is obviously 0 because no chunk-data got read so far." (gray-stream:with-stream-input-buffer (input-buffer input-index input-limit) stream (with-slots (real-input-limit chunk-input-avail) stream (setf ;; Bytes read from stream (valid data in buffer up to here) real-input-limit input-limit ;; Bytes available in current chunk block after buffer contents ;; runs out (trivially zero before first chunk block read) chunk-input-avail 0 ;; Last buffer position that can be read before new data has to ;; be fetched from stream (we must begin with parsing a chunk ;; immediately; hence set to a value that guarantees this) input-limit 0 ; or input-index? )))) ;; Lispworks fix by Edi Weitz (paserve-help 2003-11-28) #+lispworks (defmacro %with-stream-input-buffer ((input-buffer input-index input-limit) stream &body body) `(with-slots ((,input-buffer stream::input-buffer) (,input-index stream::input-index) (,input-limit stream::input-limit)) (slot-value ,stream 'stream::buffer-state) ,@body)) (defmethod gray-stream:stream-fill-buffer ((stream chunked-stream-mixin)) "Refill buffer from stream." ;; STREAM-FILL-BUFFER gets called when the input-buffer contains no ;; more data (the index is bigger than the limit). We call out to ;; the real buffer filling mechanism by calling the next specialized ;; method. This method is responsible to update the buffer state in ;; coordination with the chunk-header. (with-slots (chunk-input-avail real-input-limit) stream (#-lispworks gray-stream:with-stream-input-buffer #+lispworks %with-stream-input-buffer (input-buffer input-index input-limit) stream (labels ((pop-char () (when (and (>= input-index input-limit) ; need new data (not (call-next-method))) ; couldn't get it (error "Unexpected end-of-file while reading chunk block")) (prog1 #-lispworks (code-char (buffer-ref input-buffer input-index)) #+lispworks (buffer-ref input-buffer input-index) (incf input-index))) (read-chunk-header () (let ((chunk-length 0)) (tagbody initial-crlf (let ((char (pop-char))) (cond ((digit-char-p char 16) (decf input-index) ; unread char (go chunk-size)) ((eq #\Return char) (if (eq (pop-char) #\Linefeed) (go chunk-size) (error "End of chunk-header corrupted: Expected Linefeed"))) (t (error "End of chunk-header corrupted: Expected Carriage Return or a digit")))) chunk-size (let ((char (pop-char))) (cond ((digit-char-p char 16) (setf chunk-length (+ (* 16 chunk-length) (digit-char-p char 16))) (go chunk-size)) (t (decf input-index) ; unread char (go skip-rest)))) skip-rest (if (eq #\Return (pop-char)) (go check-linefeed) (go skip-rest)) check-linefeed (let ((char (pop-char))) (case char (#\Linefeed (go accept)) (t (error "End of chunk-header corrupted: LF expected, ~A read." char)))) accept) chunk-length))) (cond ((not (input-chunking-p stream)) ;; Chunking not active; just fill buffer normally (call-next-method)) ((zerop chunk-input-avail) ;; We are at the beginning of a new chunk. (when real-input-limit (setf input-limit real-input-limit)) (let* ((chunk-length (read-chunk-header)) (end-of-chunk (+ input-index chunk-length))) (if (zerop chunk-length) ;; rfc2616 indicates that input chunking is ;; turned off after zero-length chunk is read ;; (see section 19.4.6) -- turn off chunking (progn (signal 'acl-compat.excl::socket-chunking-end-of-file :format-arguments stream) (setf (input-chunking-p stream) nil) ;; TODO: whoever handles ;; socket-chunking-end-of-file (client.cl ;; in AllegroServe's case) should read the ;; trailer (see section 3.6). All we can ;; reasonably do here is turn off ;; chunking, or throw information away. ) ;; Now set up stream attributes so that read methods ;; call refill-buffer both at end of chunk and end of ;; buffer (progn (setf real-input-limit input-limit input-limit (min real-input-limit end-of-chunk) chunk-input-avail (max 0 (- end-of-chunk real-input-limit))) input-limit)))) (t ;; We are in the middle of a chunk; re-fill buffer (if (call-next-method) (progn (setf real-input-limit input-limit) (setf input-limit (min real-input-limit chunk-input-avail)) (setf chunk-input-avail (max 0 (- chunk-input-avail real-input-limit))) input-limit) (error "Unexpected end-of-file in the middle of a chunk")))))))) ;;;;;;;;;;;;;;;;;;;;;;; ;;; Output chunking ;;; ;;;;;;;;;;;;;;;;;;;;;;; ;; This constant is the amount of bytes the system reserves for the chunk-header ;; It is calculated as 4 bytes for the chunk-size in hexadecimal digits and a CR followed ;; by a LF (defconstant +chunk-header-buffer-offset+ 6) (defgeneric initialize-output-chunking (stream)) (defmethod initialize-output-chunking ((stream chunked-stream-mixin)) "This method initializes output chunking. Actual contents in the output-buffer get flushed first. A chunk has a header at the start and a CRLF at the end. The header is the length of the (data) content in the chunk as a string in hexadecimal digits and a trailing CRLF before the real content begins. We assume that the content of a chunk is never bigger than #xFFFF and therefore reserve 6 bytes at the beginning of the buffer for the header. We reduce the buffer limit by 2 so that we have always room left in the buffer to attach a CRLF." (unless (output-chunking-p stream) (force-output stream) (gray-stream:with-stream-output-buffer (buffer index limit) stream (setf index +chunk-header-buffer-offset+) (setf (buffer-ref buffer (- +chunk-header-buffer-offset+ 2)) #\Return (buffer-ref buffer (1- +chunk-header-buffer-offset+)) #\Linefeed) (decf limit 2) (setf (output-chunking-p stream) t)))) (defmethod gray-stream:stream-flush-buffer ((stream chunked-stream-mixin)) "When there is pending content in the output-buffer then compute the chunk-header and flush the buffer" (if (output-chunking-p stream) (gray-stream:with-stream-output-buffer (output-buffer output-index output-limit) stream (when (> output-index +chunk-header-buffer-offset+) (let* ((chunk-header (format nil "~X" (- output-index +chunk-header-buffer-offset+))) (start (- +chunk-header-buffer-offset+ 2 (length chunk-header)))) (loop for c across chunk-header for i upfrom start do (setf (buffer-ref output-buffer i) c)) (setf (buffer-ref output-buffer output-index) #\Return (buffer-ref output-buffer (1+ output-index)) #\Linefeed) (gray-stream:stream-write-buffer stream output-buffer start (+ output-index 2)) (setf output-index +chunk-header-buffer-offset+)))) (call-next-method))) (defmethod close ((stream chunked-stream-mixin) &key abort) (unless abort (disable-output-chunking stream)) (call-next-method)) (defgeneric disable-output-chunking (stream)) (defmethod disable-output-chunking ((stream chunked-stream-mixin)) "When we disable chunking we first try to write out a last pending chunk and after that reset the buffer-state to normal mode. To end the game we write out a chunk-header with a chunk-size of zero to notify the peer that chunking ends." (when (output-chunking-p stream) (force-output stream) (gray-stream:with-stream-output-buffer (buffer index limit) stream (setf index 0) (incf limit 2)) (setf (output-chunking-p stream) nil (input-chunking-p stream) nil) (format stream "0~A~A~A~A" #\Return #\Linefeed #\Return #\Linefeed) (force-output stream))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/chunked.lisp000066400000000000000000000162311133377100500243630ustar00rootroot00000000000000;;; ;;; Streams with support for "chunked" transfer coding. This module ;;; emulates the support for chunking found in Allegro Common Lisp's ;;; streams. See RFC 2616 for a description of the "chunked" transfer ;;; coding. ;;; ;;; TODO: ;;; - (defpackage :com.ljosa.chunked (:use :common-lisp #+LISPWORKS :stream) (:export :chunked-mixin :make-chunked-stream :*buffer-size* :output-chunking :input-chunking :close-chunk)) (in-package :com.ljosa.chunked) (defparameter *buffer-size* 1024 "Maximum chunk size") (defvar *recursive* nil) (defclass chunked-mixin () ((output-chunking :initform nil :accessor output-chunking) (input-chunking :initform nil :accessor input-chunking) (output-buffer) (remaining-input :initform nil))) (defmethod shared-initialize :after ((stream chunked-mixin) slots-for-initform &rest initargs) (declare (ignore initargs slots-for-initform)) (with-slots (output-buffer) stream (setf output-buffer (make-array (list *buffer-size*) :element-type 'unsigned-byte :fill-pointer 0)))) (define-condition excl::socket-chunking-end-of-file (condition) ((excl::format-arguments :initform nil) (excl::format-control :initform "~1@"))) ;; (defmethod stream-element-type ((stream chunked-mixin)) ;; (call-next-method)) (defun read-chunk-header (stream &aux (x 0) (*recursive* t)) (tagbody s0 (let ((char (read-char stream))) (cond ((digit-char-p char 16) (setf x (+ (* 16 x) (digit-char-p char 16))) (go s0)) ((eq #\; char) (go s1)) ((eq #\; char) (go s2)) (t (error "Parse error in state s0: ~S." char)))) s1 (if (eq #\Return (read-char stream)) (go s2) (go s1)) s2 (let ((char (read-char stream))) (case char (#\Linefeed (go accept)) (t (error "Parse error in state s2: ~S." char)))) accept) x) ;; FIXME: What do do when the chunked input stream can't be parsed? (defun gobble-crlf (stream &aux (*recursive* t)) (flet ((expect (expected-char) (let ((char (read-char stream))) (unless (eq expected-char char) (error "Expected ~C, got ~C." expected-char char))))) (expect #\Return) (expect #\Linefeed))) (defmethod stream-read-char ((stream chunked-mixin)) (with-slots (input-chunking remaining-input output-chunking) stream (cond (*recursive* (call-next-method)) ((not input-chunking) (call-next-method)) ((not remaining-input) (handler-case (progn (setf remaining-input (read-chunk-header stream)) (stream-read-char stream)) (end-of-file () :eof))) ((> remaining-input 0) (decf remaining-input) (call-next-method)) ((zerop remaining-input) (handler-case (progn (gobble-crlf stream) (setf remaining-input (read-chunk-header stream)) (cond ((zerop remaining-input) (setf input-chunking nil output-chunking nil) (signal 'excl::socket-chunking-end-of-file :format-arguments stream) :eof) (t (stream-read-char stream)))) (end-of-file () :eof)))))) (defmethod stream-unread-char ((stream chunked-mixin) character) (with-slots (input-chunking remaining-input) stream (cond (*recursive* (call-next-method)) (input-chunking (incf remaining-input) (call-next-method)) (t (call-next-method))))) (defmethod stream-read-line ((stream chunked-mixin)) (loop with chars = nil for char = (stream-read-char stream) until (eq char #\Linefeed) do (if (eq char :eof) (if (null chars) (error 'end-of-file :stream stream) (return (coerce chars 'string))) (push char chars)) finally (return (coerce (nreverse chars) 'string)))) (defmethod stream-read-sequence ((stream chunked-mixin) sequence start end) (loop for i from start below end do (let ((char (stream-read-char stream))) (case char (:eof (return i)) (t (setf (elt sequence i) char)))) finally (return i))) (defmethod stream-clear-input ((stream chunked-mixin)) (with-slots (input-chunking) stream (cond (*recursive* (call-next-method)) (input-chunking nil) (t (call-next-method))))) (defmethod stream-write-byte ((stream chunked-mixin) byte) (check-type byte unsigned-byte) (if *recursive* (call-next-method) (with-slots (output-buffer) stream (or (vector-push byte output-buffer) (progn (stream-force-output stream) (stream-write-byte stream byte)))))) (defmethod stream-write-char ((stream chunked-mixin) character) (if *recursive* (call-next-method) (stream-write-byte stream (char-code character)))) (defmethod stream-write-sequence ((stream chunked-mixin) sequence start end) (loop for i from start below end do (let ((e (elt sequence i))) (etypecase e (integer (stream-write-byte stream e)) (character (stream-write-char stream e)))))) (defmethod stream-write-string ((stream chunked-mixin) string &optional (start 0) (end (length string))) (stream-write-sequence stream string start end)) (defmethod write-crlf ((stream stream)) (let ((*recursive* t)) (write-char #\Return stream) (write-char #\Linefeed stream))) (defmethod stream-force-output ((stream chunked-mixin)) (with-slots (output-chunking output-buffer) stream (when (> (fill-pointer output-buffer) 0) (let ((*recursive* t)) (when output-chunking (let ((*print-base* 16)) (princ (fill-pointer output-buffer) stream)) (write-crlf stream)) (write-sequence output-buffer stream) (setf (fill-pointer output-buffer) 0) (when output-chunking (write-crlf stream))))) (call-next-method)) (defmethod stream-finish-output ((stream chunked-mixin)) (unless *recursive* (force-output stream)) (call-next-method)) (defmethod stream-clear-output ((stream chunked-mixin)) (with-slots (output-chunking output-buffer) stream (if (and output-chunking (not *recursive*)) (setf (fill-pointer output-buffer) 0) (call-next-method)))) (defmethod close ((stream chunked-mixin) &key abort) (unless abort (finish-output stream)) (with-slots (output-chunking output-buffer) stream (when (and output-chunking (> (fill-pointer output-buffer) 0)) (close-chunk stream))) (call-next-method)) (defmethod close-chunk ((stream chunked-mixin)) (finish-output stream) (with-slots (output-chunking input-chunking) stream (if output-chunking (let ((*recursive* t)) (princ 0 stream) (write-crlf stream) (write-crlf stream) (finish-output stream) (setf output-chunking nil input-chunking nil)) (error "Chunking is not enabled for output on this stream: ~S." stream)))) (provide :com.ljosa.chunked) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/clisp/000077500000000000000000000000001133377100500231605ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/clisp/acl-excl.lisp000066400000000000000000000047531133377100500255520ustar00rootroot00000000000000;;;; ;;;; ACL-COMPAT - EXCL ;;;; ;;;; Implementation-specific parts of acl-compat.excl (see ;;;; acl-excl-common.lisp) (in-package :acl-compat.excl) (defun fixnump (x) (sys::fixnump x)) (defun stream-input-fn (stream) stream) (defun filesys-type (file-or-directory-name) ;; Taken from clocc's port library, with thanks to Sam Steingold (if (values (ignore-errors (#+lisp=cl ext:probe-directory #-lisp=cl lisp:probe-directory file-or-directory-name))) :directory (if (probe-file file-or-directory-name) :file nil))) (defmacro atomically (&body forms) ;; No multiprocessing here, move along... `(progn ,@forms)) (defun unix-signal (signal pid) (declare (ignore signal pid)) (error "clisp unix-signal not implemented yet.")) (defmacro without-package-locks (&body forms) `(ext:without-package-lock ,(list-all-packages) ,@forms)) (defun fixnump (x) (sys::fixnump x)) (defun string-to-octets (string &key (null-terminate t) (start 0) end mb-vector make-mb-vector? (external-format :default)) "This function returns a lisp-usb8-vector and the number of bytes copied." (declare (ignore external-format)) ;; The end parameter is different in ACL's lambda list, but this ;; variant lets us give an argument :end nil explicitly, and the ;; right thing will happen (unless end (setf end (length string))) (let* ((number-of-octets (if null-terminate (1+ (- end start)) (- end start))) (mb-vector (cond ((and mb-vector (>= (length mb-vector) number-of-octets)) mb-vector) ((or (not mb-vector) make-mb-vector?) (make-array (list number-of-octets) :element-type '(unsigned-byte 8) :initial-element 0)) (t (error "Was given a vector of length ~A, ~ but needed at least length ~A." (length mb-vector) number-of-octets))))) (declare (type (simple-array (unsigned-byte 8) (*)) mb-vector)) (loop for from-index from start below end for to-index upfrom 0 do (progn (setf (aref mb-vector to-index) (char-code (aref string from-index))))) (when null-terminate (setf (aref mb-vector (1- number-of-octets)) 0)) (values mb-vector number-of-octets))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/clisp/acl-mp.lisp000066400000000000000000000045201133377100500252230ustar00rootroot00000000000000;; Stubs for multiprocessing functions under clisp. Clisp does not ;; provide threads at the time of writing, so these functions are here ;; only to compile aserve with a minimum of changes in the main code. ;; ;; Written by Rudi Schlatte (in-package :acl-compat-mp) (defvar *current-process*) (defun process-allow-schedule () (values)) (defun process-allow-scheduling () (values)) (defun process-plist (process) (declare (ignore process)) (error "Attempting to use multithreading with clisp.")) (defun (setf process-plist) (new-value process) (declare (ignore new-value process)) (error "Attempting to use multithreading with clisp.")) (defun process-run-reasons (process) (declare (ignore process)) (error "Attempting to use multithreading with clisp.")) (defun (setf process-run-reasons) (new-value process) (declare (ignore new-value process)) (error "Attempting to use multithreading with clisp.")) (defun process-revoke-run-reason (process object) (declare (ignore process object)) (error "Attempting to use multithreading with clisp.")) (defun process-add-run-reason (process object) (declare (ignore process object)) (error "Attempting to use multithreading with clisp.")) (defun process-run-function (name function &rest arguments) (declare (ignore name function arguments)) (error "Attempting to use multithreading with clisp.")) (defun process-kill (process) (declare (ignore process)) (error "Attempting to use multithreading with clisp.")) (defmacro with-gensyms (syms &body body) "Bind symbols to gensyms. First sym is a string - `gensym' prefix. Inspired by Paul Graham, , p. 145." `(let (,@(mapcar (lambda (sy) `(,sy (gensym ,(car syms)))) (cdr syms))) ,@body)) (defun interrupt-process (process function &rest args) (declare (ignore process function args)) (error "Attempting to use multithreading with clisp.")) (defun make-process-lock (&key name) (declare (ignore name)) (error "Attempting to use multithreading with clisp.")) (defmacro with-process-lock ((lock &key norecursive whostate timeout) &body forms) (declare (ignore lock norecursive whostate timeout)) `(progn ,@forms)) (defmacro with-timeout ((seconds &body timeout-forms) &body body) (declare (ignore seconds timeout-forms)) `(progn ,@body)) (defmacro without-scheduling (&body body) `(progn ,@body)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/clisp/acl-socket.lisp000066400000000000000000000147021133377100500261020ustar00rootroot00000000000000;; This package is designed for clisp. It implements the ;; ACL-style socket interface on top of clisp. ;; ;; Written by Rudi Schlatte, based on the work done by Jochen Schmidt ;; for Lispworks and net.lisp in the port library of CLOCC. (in-package :acl-socket) (defclass server-socket () ((port :type fixnum :initarg :port :reader port) (stream-type :type (member :text :binary :bivalent) :initarg :stream-type :reader stream-type :initform (error "No value supplied for stream-type")) (clisp-socket-server :initarg :clisp-socket-server :reader clisp-socket-server))) (defmethod print-object ((server-socket server-socket) stream) (print-unreadable-object (server-socket stream :type t :identity nil) (format stream "@port ~d" (port server-socket)))) (defun %get-element-type (format) (ecase format (:text 'character) (:binary '(unsigned-byte 8)) (:bivalent '(unsigned-byte 8))) ) (defgeneric accept-connection (server-socket &key wait)) (defmethod accept-connection ((server-socket server-socket) &key (wait t)) "Return a bidirectional stream connected to socket, or nil if no client wanted to initiate a connection and wait is nil." (when (cond ((numberp wait) (socket-wait (clisp-socket-server server-socket) wait)) (wait (socket-wait (clisp-socket-server server-socket))) (t (socket-wait (clisp-socket-server server-socket) 0))) (let ((stream (socket-accept (clisp-socket-server server-socket) :element-type (%get-element-type (stream-type server-socket)) ))) (if (eq (stream-type server-socket) :bivalent) (make-bivalent-stream stream) stream)))) (defun make-socket (&key (remote-host "localhost") local-port remote-port (connect :active) (format :text) &allow-other-keys) "Return a stream connected to remote-host if connect is :active, or something listening on local-port that can be fed to accept-connection if connect is :passive." (check-type remote-host string) (ecase connect (:passive (make-instance 'server-socket :port local-port :clisp-socket-server (socket-server local-port) :stream-type format)) (:active (let ((stream (socket-connect remote-port remote-host :element-type (%get-element-type format) ))) (if (eq format :bivalent) (make-bivalent-stream stream) stream))))) (defmethod close ((server-socket server-socket) &key abort) "Kill a passive (listening) socket. (Active sockets are actually streams and handled by their close methods." (declare (ignore abort)) (socket-server-close (clisp-socket-server server-socket))) (declaim (ftype (function ((unsigned-byte 32)) (values simple-string)) ipaddr-to-dotted)) (defun ipaddr-to-dotted (ipaddr &key values) (declare (type (unsigned-byte 32) ipaddr)) (let ((a (logand #xff (ash ipaddr -24))) (b (logand #xff (ash ipaddr -16))) (c (logand #xff (ash ipaddr -8))) (d (logand #xff ipaddr))) (if values (values a b c d) (format nil "~d.~d.~d.~d" a b c d)))) (defun string-tokens (string) (labels ((get-token (str pos1 acc) (let ((pos2 (position #\Space str :start pos1))) (if (not pos2) (nreverse acc) (get-token str (1+ pos2) (cons (read-from-string (subseq str pos1 pos2)) acc)))))) (get-token (concatenate 'string string " ") 0 nil))) (declaim (ftype (function (string &key (:errorp t)) (values (unsigned-byte 32))) dotted-to-ipaddr)) (defun dotted-to-ipaddr (dotted &key (errorp t)) (declare (string dotted)) (if errorp (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll))) (ignore-errors (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll)))))) (defun ipaddr-to-hostname (ipaddr &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword in IPADDR-TO-HOSTNAME not supported.")) (posix::hostent-name (posix:resolve-host-ipaddr ipaddr))) (defun lookup-hostname (host &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword in LOOKUP-HOSTNAME not supported.")) (if (stringp host) (car (posix::hostent-addr-list (posix:resolve-host-ipaddr host))) (dotted-to-ipaddr (ipaddr-to-dotted host)))) (defgeneric get-clisp-stream (stream)) (defmethod get-clisp-stream ((stream gray-stream::native-lisp-stream-mixin)) (gray-stream::native-lisp-stream stream)) (defmethod get-clisp-stream ((stream t)) (the stream stream)) (defun remote-host (socket-stream) (dotted-to-ipaddr (nth-value 0 (socket-stream-peer (get-clisp-stream socket-stream) t)))) (defun remote-port (socket-stream) (nth-value 1 (socket-stream-peer (get-clisp-stream socket-stream) t))) (defun local-host (socket-stream) (dotted-to-ipaddr (nth-value 0 (socket-stream-local (get-clisp-stream socket-stream) t)))) (defun local-port (socket-stream) (nth-value 1 (socket-stream-local (get-clisp-stream socket-stream) t))) ;; Now, throw chunking in the mix (defclass chunked-stream (de.dataheaven.chunked-stream-mixin::chunked-stream-mixin gray-stream::buffered-bivalent-stream) ((plist :initarg :plist :accessor stream-plist))) (defun make-bivalent-stream (lisp-stream &key plist) (make-instance 'chunked-stream :lisp-stream lisp-stream :plist plist)) (defun socket-control (stream &key (output-chunking nil oc-p) output-chunking-eof (input-chunking nil ic-p)) (when oc-p (when output-chunking (de.dataheaven.chunked-stream-mixin::initialize-output-chunking stream)) (setf (de.dataheaven.chunked-stream-mixin::output-chunking-p stream) output-chunking)) (when output-chunking-eof (de.dataheaven.chunked-stream-mixin::disable-output-chunking stream)) (when ic-p (when input-chunking (de.dataheaven.chunked-stream-mixin::initialize-input-chunking stream)) (setf (de.dataheaven.chunked-stream-mixin::input-chunking-p stream) input-chunking))) (provide 'acl-socket) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/clisp/acl-sys.lisp000066400000000000000000000012371133377100500254270ustar00rootroot00000000000000 (eval-when (:compile-toplevel :load-toplevel :execute) (ext:without-package-lock () (let ((sys-package (find-package "SYSTEM"))) (export (list (intern "COMMAND-LINE-ARGUMENTS" sys-package) (intern "COMMAND-LINE-ARGUMENT" sys-package) (intern "REAP-OS-SUBPROCESS" sys-package)) sys-package)))) (ext:without-package-lock () (defun sys:command-line-arguments () ext:*args*)) (ext:without-package-lock () (defun sys:command-line-argument (n) (nth n ext:*args*))) (ext:without-package-lock () (defun sys:reap-os-subprocess (&key (wait nil)) (declare (ignore wait)) nil)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/cmucl/000077500000000000000000000000001133377100500231515ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/cmucl/acl-excl.lisp000066400000000000000000000051261133377100500255360ustar00rootroot00000000000000;;;; ;;;; ACL-COMPAT - EXCL ;;;; ;;;; Implementation-specific parts of acl-compat.excl (see ;;;; acl-excl-common.lisp) (in-package :acl-compat.excl) (defun stream-input-fn (stream) stream) (defun filesys-type (file-or-directory-name) (if (eq :directory (unix:unix-file-kind (namestring file-or-directory-name))) :directory (if (probe-file file-or-directory-name) :file nil))) (defmacro atomically (&body forms) `(mp:without-scheduling ,@forms)) (defun unix-signal (signal pid) ;; fixxme: did I get the arglist right? only invocation I have seen ;; is (excl::unix-signal 15 0) in net.aserve:start (unix:unix-kill pid signal)) (defmacro without-package-locks (&body forms) `(progn ,@forms)) (defun filesys-inode (path) (multiple-value-bind (found ign inode) (unix:unix-lstat path) (if found inode (error "path ~s does not exist" path)))) (defun cl-internal-real-time () (round (/ (get-internal-real-time) internal-time-units-per-second))) (defun string-to-octets (string &key (null-terminate t) (start 0) end mb-vector make-mb-vector? (external-format :default)) "This function returns a lisp-usb8-vector and the number of bytes copied." (declare (ignore external-format)) ;; The end parameter is different in ACL's lambda list, but this ;; variant lets us give an argument :end nil explicitly, and the ;; right thing will happen (unless end (setf end (length string))) (let* ((number-of-octets (if null-terminate (1+ (- end start)) (- end start))) (mb-vector (cond ((and mb-vector (>= (length mb-vector) number-of-octets)) mb-vector) ((or (not mb-vector) make-mb-vector?) (make-array (list number-of-octets) :element-type '(unsigned-byte 8) :initial-element 0)) (t (error "Was given a vector of length ~A, ~ but needed at least length ~A." (length mb-vector) number-of-octets))))) (declare (type (simple-array (unsigned-byte 8) (*)) mb-vector)) (loop for from-index from start below end for to-index upfrom 0 do (progn (setf (aref mb-vector to-index) (char-code (aref string from-index))))) (when null-terminate (setf (aref mb-vector (1- number-of-octets)) 0)) (values mb-vector number-of-octets))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/cmucl/acl-mp.lisp000066400000000000000000000133021133377100500252120ustar00rootroot00000000000000;; This package is designed for cmucl. It implements ACL-style ;; multiprocessing on top of cmucl (basically, process run reasons and ;; some function renames). ;; ;; Written by Rudi Schlatte, based on the work done by Jochen Schmidt ;; for Lispworks. (in-package :acl-compat.mp) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Import equivalent parts from the CMU MP package ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (shadowing-import '(mp:*current-process* ;; mp::process-preset mp::process-reset mp:process-interrupt mp::process-name mp::process-wait-function mp:process-run-reasons mp:process-add-run-reason mp:process-revoke-run-reason mp:process-arrest-reasons mp:process-add-arrest-reason mp:process-revoke-arrest-reason mp:process-whostate ; mp:without-interrupts mp:process-wait mp:with-timeout mp:without-scheduling mp:process-active-p )) (export '(*current-process* ;; process-preset process-reset process-interrupt process-name process-wait-function process-whostate process-wait with-timeout without-scheduling process-run-reasons process-add-run-reason process-revoke-run-reason process-arrest-reasons process-add-arrest-reason process-revoke-arrest-reason process-active-p )) (defun process-allow-schedule () (mp:process-yield)) (defvar *process-plists* (make-hash-table :test #'eq) "maps processes to their plists. See the functions process-plist, (setf process-plist).") (defun process-property-list (process) (gethash process *process-plists*)) (defun (setf process-property-list) (new-value process) (setf (gethash process *process-plists*) new-value)) #|| ;;; rudi 2002-06-09: This is not needed as of cmucl 18d, thanks to Tim ;;; Moore who added run reasons to cmucl's multithreading. Left in ;;; for the time being just in case someone wants to get acl-compat ;;; running on older cmucl's. Can be deleted safely. (defvar *process-run-reasons* (make-hash-table :test #'eq) "maps processes to their run-reasons. See the functions process-run-reasons, (setf process-run-reasons), process-add-run-reason, process-revoke-run-reason.") (defun process-run-reasons (process) (gethash process *process-run-reasons*)) (defun (setf process-run-reasons) (new-value process) (mp:without-scheduling (prog1 (setf (gethash process *process-run-reasons*) new-value) (if new-value (mp:enable-process process) (mp:disable-process process))))) (defun process-revoke-run-reason (process object) (without-scheduling (setf (process-run-reasons process) (remove object (process-run-reasons process)))) (when (and (eq process mp:*current-process*)) (mp:process-yield))) (defun process-add-run-reason (process object) (setf (process-run-reasons process) (pushnew object (process-run-reasons process)))) ||# (defun process-run-function (name-or-options preset-function &rest preset-arguments) (let ((process (etypecase name-or-options (string (make-process :name name-or-options :run-reasons '(t))) (list (apply #'make-process :run-reasons '(t) name-or-options))))) (apply #'acl-mp::process-preset process preset-function preset-arguments) process)) (defun process-preset (process preset-function &rest arguments) (mp:process-preset process #'(lambda () (apply-with-bindings preset-function arguments (process-initial-bindings process))))) (defvar *process-initial-bindings* (make-hash-table :test #'eq)) (defun process-initial-bindings (process) (gethash process *process-initial-bindings*)) (defun (setf process-initial-bindings) (bindings process) (setf (gethash process *process-initial-bindings*) bindings)) ;;; ;;; ;;; Contributed by Tim Moore ;;; ;;; ;;; (defun apply-with-bindings (function args bindings) (if bindings (progv (mapcar #'car bindings) (mapcar #'(lambda (binding) (eval (cdr binding))) bindings) (apply function args)) (apply function args))) (defun make-process (&key (name "Anonymous") reset-action run-reasons arrest-reasons (priority 0) quantum resume-hook suspend-hook initial-bindings run-immediately) (declare (ignore priority quantum reset-action resume-hook suspend-hook run-immediately)) (mp:make-process nil :name name :run-reasons run-reasons :arrest-reasons arrest-reasons :initial-bindings initial-bindings)) (defun process-kill (process) (mp:destroy-process process)) (defun make-process-lock (&key name) (mp:make-lock name)) (defun process-lock (lock) (mp::lock-wait lock (mp:process-whostate mp:*current-process*))) (defun process-unlock (lock) (setf (mp::lock-process lock) nil)) (defmacro with-process-lock ((lock &key norecursive whostate timeout) &body forms) (declare (ignore norecursive)) `(mp:with-lock-held (,lock ,@(when whostate (list :whostate whostate)) ,@(when timeout (list :timeout timeout))) ,@forms)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/cmucl/acl-socket.lisp000066400000000000000000000171171133377100500260760ustar00rootroot00000000000000;; This package is designed for cmucl. It implements the ;; ACL-style socket interface on top of cmucl. ;; ;; Written by Rudi Schlatte, based on the work done by Jochen Schmidt ;; for Lispworks and net.lisp in the port library of CLOCC. (in-package acl-compat.socket) (defclass socket () ((fd :type fixnum :initarg :fd :reader fd))) (defmethod print-object ((socket socket) stream) (print-unreadable-object (socket stream :type t :identity t) (format stream "@~d" (fd socket)))) (defclass server-socket (socket) ((element-type :type (member signed-byte unsigned-byte base-char) :initarg :element-type :reader element-type :initform (error "No value supplied for element-type")) (port :type fixnum :initarg :port :reader port :initform (error "No value supplied for port")) (stream-type :type (member :text :binary :bivalent) :initarg :stream-type :reader stream-type :initform (error "No value supplied for stream-type")))) #+cl-ssl (defmethod make-ssl-server-stream ((lisp-stream system:lisp-stream) &rest options) (apply #'make-ssl-server-stream (system:fd-stream-fd lisp-stream) options)) (defmethod print-object ((socket server-socket) stream) (print-unreadable-object (socket stream :type t :identity nil) (format stream "@~d on port ~d" (fd socket) (port socket)))) (defmethod accept-connection ((server-socket server-socket) &key (wait t)) "Return a bidirectional stream connected to socket, or nil if no client wanted to initiate a connection and wait is nil." ;; fixxme: perhaps check whether we run multiprocessing and use ;; sys:wait-until-fd-usable instead of ;; mp:process-wait-until-fd-usable here? ;; api pipe fitting: wait t ==> timeout nil (when (mp:process-wait-until-fd-usable (fd server-socket) :input (if wait nil 0)) (let ((stream (sys:make-fd-stream (ext:accept-tcp-connection (fd server-socket)) :input t :output t :element-type (element-type server-socket) :auto-close t))) (if (eq (stream-type server-socket) :bivalent) (make-bivalent-stream stream) stream)))) (defun make-socket (&key (remote-host "localhost") local-port remote-port (connect :active) (format :text) (reuse-address t) &allow-other-keys) "Return a stream connected to remote-host if connect is :active, or something listening on local-port that can be fed to accept-connection if connect is :passive. This is an incomplete implementation of ACL's make-socket function! It was written to provide the functionality necessary to port AllegroServe. Refer to http://franz.com/support/documentation/6.1/doc/pages/operators/socket/make-socket.htm to read about the missing parts." (check-type remote-host string) (let ((element-type (ecase format (:text 'base-char) (:binary 'signed-byte) (:bivalent 'unsigned-byte)))) (ecase connect (:passive (make-instance 'server-socket :port local-port :fd (ext:create-inet-listener local-port :stream :reuse-address reuse-address) :element-type element-type :stream-type format)) (:active (let ((stream (sys:make-fd-stream (ext:connect-to-inet-socket remote-host remote-port) :input t :output t :element-type element-type))) (if (eq :bivalent format) (make-bivalent-stream stream) stream)))))) (defmethod close ((server server-socket) &key abort) "Kill a passive (listening) socket. (Active sockets are actually streams and handled by their close methods." (declare (ignore abort)) (unix:unix-close (fd server))) (declaim (ftype (function ((unsigned-byte 32) &key (:values t)) (values simple-string)) ipaddr-to-dotted)) (defun ipaddr-to-dotted (ipaddr &key values) (declare (type (unsigned-byte 32) ipaddr)) (let ((a (logand #xff (ash ipaddr -24))) (b (logand #xff (ash ipaddr -16))) (c (logand #xff (ash ipaddr -8))) (d (logand #xff ipaddr))) (if values (values a b c d) (format nil "~d.~d.~d.~d" a b c d)))) (defun string-tokens (string) (labels ((get-token (str pos1 acc) (let ((pos2 (position #\Space str :start pos1))) (if (not pos2) (nreverse acc) (get-token str (1+ pos2) (cons (read-from-string (subseq str pos1 pos2)) acc)))))) (get-token (concatenate 'string string " ") 0 nil))) (declaim (ftype (function (string &key (:errorp t)) (values (unsigned-byte 32))) dotted-to-ipaddr)) (defun dotted-to-ipaddr (dotted &key (errorp t)) (declare (string dotted)) (if errorp (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll))) (ignore-errors (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll)))))) (defun ipaddr-to-hostname (ipaddr &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword in IPADDR-TO-HOSTNAME not supported.")) (ext:host-entry-name (ext:lookup-host-entry ipaddr))) (defun lookup-hostname (host &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword in LOOKUP-HOSTNAME not supported.")) (if (stringp host) (car (ext:host-entry-addr-list (ext:lookup-host-entry host))) (dotted-to-ipaddr (ipaddr-to-dotted host)))) (defgeneric get-fd (stream)) (defmethod get-fd ((stream gray-stream::native-lisp-stream-mixin)) (system:fd-stream-fd (gray-stream::native-lisp-stream stream))) (defmethod get-fd ((stream system:lisp-stream)) (system:fd-stream-fd stream)) (defmethod get-fd ((stream server-socket)) (fd stream)) (defun remote-host (socket-stream) (ext:get-peer-host-and-port (get-fd socket-stream))) (defun remote-port (socket-stream) (multiple-value-bind (host port) (ext:get-peer-host-and-port (get-fd socket-stream)) (declare (ignore host)) port)) (defun local-host (socket-stream) (ext:get-socket-host-and-port (get-fd socket-stream))) (defun local-port (socket-stream) (if (typep socket-stream 'socket::server-socket) (port socket-stream) (multiple-value-bind (host port) (ext:get-socket-host-and-port (get-fd socket-stream)) (declare (ignore host)) port))) ;; Now, throw chunking in the mix (defclass chunked-stream (de.dataheaven.chunked-stream-mixin::chunked-stream-mixin gray-stream::buffered-bivalent-stream) ()) (defun make-bivalent-stream (lisp-stream) (make-instance 'chunked-stream :lisp-stream lisp-stream)) (defun socket-control (stream &key (output-chunking nil oc-p) output-chunking-eof (input-chunking nil ic-p)) (when oc-p (when output-chunking (de.dataheaven.chunked-stream-mixin::initialize-output-chunking stream)) (setf (de.dataheaven.chunked-stream-mixin::output-chunking-p stream) output-chunking)) (when output-chunking-eof (de.dataheaven.chunked-stream-mixin::disable-output-chunking stream)) (when ic-p (when input-chunking (de.dataheaven.chunked-stream-mixin::initialize-input-chunking stream)) (setf (de.dataheaven.chunked-stream-mixin::input-chunking-p stream) input-chunking))) (provide 'acl-socket) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/cmucl/acl-sys.lisp000066400000000000000000000005471133377100500254230ustar00rootroot00000000000000(in-package :acl-compat.system) (ignore-errors (export 'command-line-arguments) (export 'command-line-argument) (export 'reap-os-subprocess) (defun command-line-arguments () ext:*command-line-strings*) (defun command-line-argument (n) (nth n ext:*command-line-strings*)) (defun reap-os-subprocess (&key (wait nil)) (declare (ignore wait)) nil) ) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/defsys.lisp000066400000000000000000000027351133377100500242430ustar00rootroot00000000000000(in-package "CL-USER") (defsystem "ACL-COMPAT" (:default-pathname "ACL-COMPAT:") :members ("acl-compat-common-lisp-lw" "nregex" "acl-excl-lw" "acl-mp-package" "acl-mp-lw" "gray-stream-package" "acl-socket-lw" "acl-sys-lw" "meta" "uri" "chunked-stream-mixin") :rules ((:in-order-to :compile "acl-excl-lw" (:caused-by (:compile "nregex")) (:requires (:load "nregex"))) (:in-order-to :load "acl-excl-lw" (:requires (:load "nregex"))) (:in-order-to :compile "acl-mp-lw" (:caused-by (:compile "acl-mp-package" "acl-socket-lw")) (:requires (:load "acl-mp-package" "acl-socket-lw"))) (:in-order-to :load "acl-mp-lw" (:requires (:load "acl-mp-package" "acl-socket-lw"))) (:in-order-to :compile "acl-socket-lw" (:caused-by (:compile "chunked-stream-mixin")) (:requires (:load "chunked-stream-mixin"))) (:in-order-to :load "acl-socket-lw" (:requires (:load "chunked-stream-mixin"))) (:in-order-to :compile "chunked-stream-mixin" (:caused-by (:compile "acl-excl-lw" "gray-stream-package")) (:requires (:load "acl-excl-lw" "gray-stream-package"))) (:in-order-to :load "chunked-stream-mixin" (:requires (:load "acl-excl-lw" "gray-stream-package"))) (:in-order-to :compile "uri" (:caused-by (:compile "meta")) (:requires (:load "meta"))) (:in-order-to :load "uri" (:requires (:load "meta"))))) (eval-when (:load-toplevel :execute) (pushnew :acl-compat *features*)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/lispworks/000077500000000000000000000000001133377100500241035ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/lispworks/acl-excl.lisp000066400000000000000000000054651133377100500264760ustar00rootroot00000000000000;;;; ;;;; ACL-COMPAT - EXCL ;;;; ;;;; Implementation-specific parts of acl-compat.excl (see ;;;; acl-excl-common.lisp) (in-package :acl-compat.excl) #+obsolete (defun stream-input-fn (stream) stream) (defmethod stream-input-fn ((stream stream)) stream) (defun filesys-type (file-or-directory-name) (if (lw::file-directory-p file-or-directory-name) :directory (if (probe-file file-or-directory-name) :file nil))) #-:win32 (defun filesys-inode (path) (let ((checked-path (probe-file path))) (cond (checked-path (let ((stat (system:get-file-stat checked-path))) (system:file-stat-inode stat))) (t (error "path ~a does not exist." path))))) (defmacro atomically (&body forms) `(mp:without-preemption ,@forms)) (defmacro without-package-locks (&body forms) `(progn ,@forms)) #| (defun run-shell-command () (with-open-stream (s (open-pipe "/bin/sh" :direction :io :buffered nil)) (loop for var in environment do (format stream "~A=~A~%" (car var) (cdr var))) |# ;; NDL 2004-06-04 -- Missing definition & a package, to allow LispWorks to load webactions (defun cl-internal-real-time () (round (/ (get-internal-real-time) 1000))) (defun string-to-octets (string &key (null-terminate t) (start 0) end mb-vector make-mb-vector? (external-format :default)) "This function returns a lisp-usb8-vector and the number of bytes copied." (declare (ignore external-format)) ;; The end parameter is different in ACL's lambda list, but this ;; variant lets us give an argument :end nil explicitly, and the ;; right thing will happen (unless end (setf end (length string))) (let* ((number-of-octets (if null-terminate (1+ (- end start)) (- end start))) (mb-vector (cond ((and mb-vector (>= (length mb-vector) number-of-octets)) mb-vector) ((or (not mb-vector) make-mb-vector?) (make-array (list number-of-octets) :element-type '(unsigned-byte 8) :initial-element 0)) (t (error "Was given a vector of length ~A, ~ but needed at least length ~A." (length mb-vector) number-of-octets))))) (declare (type (simple-array (unsigned-byte 8) (*)) mb-vector)) (loop for from-index from start below end for to-index upfrom 0 do (progn (setf (aref mb-vector to-index) (char-code (aref string from-index))))) (when null-terminate (setf (aref mb-vector (1- number-of-octets)) 0)) (values mb-vector number-of-octets))) (provide 'acl-excl) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/lispworks/acl-mp.lisp000066400000000000000000000207461133377100500261560ustar00rootroot00000000000000;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: CL-USER; -*- ;;;; ; ;;;; (c) 2001 by Jochen Schmidt. ;;;; ;;;; File: acl-mp-lw.lisp ;;;; Revision: 1.0.0 ;;;; Description: LispWorks implementation for ACL-COMPAT-MP ;;;; Date: 02.02.2002 ;;;; Authors: Jochen Schmidt ;;;; Tel: (+49 9 11) 47 20 603 ;;;; Email: jsc@dataheaven.de ;;;; ;;;; Redistribution and use in source and binary forms, with or without ;;;; modification, are permitted provided that the following conditions ;;;; are met: ;;;; 1. Redistributions of source code must retain the above copyright ;;;; notice, this list of conditions and the following disclaimer. ;;;; 2. Redistributions in binary form must reproduce the above copyright ;;;; notice, this list of conditions and the following disclaimer in the ;;;; documentation and/or other materials provided with the distribution. ;;;; ;;;; THIS SOFTWARE IS PROVIDED "AS IS" AND THERE ARE NEITHER ;;;; EXPRESSED NOR IMPLIED WARRANTIES - THIS INCLUDES, BUT ;;;; IS NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY ;;;; AND FITNESS FOR A PARTICULAR PURPOSE.IN NO WAY ARE THE ;;;; AUTHORS LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ;;;; SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ;;;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES ; ;;;; LOSS OF USE, DATA, OR PROFITS ; OR BUSINESS INTERRUPTION) ;;;; ;;;; For further details contact the authors of this software. ;;;; ;;;; Jochen Schmidt ;;;; Zuckmantelstr. 11 ;;;; 91616 Neusitz ;;;; GERMANY ;;;; ;;;; (eval-when (:compile-toplevel :load-toplevel :execute) (require "comm")) (in-package :acl-compat-mp) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Import equivalent parts from the LispWorks MP package ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (:compile-toplevel :load-toplevel :execute) (shadowing-import '( mp:*current-process* mp:process-kill mp:process-enable mp:process-disable mp::process-preset mp:process-reset mp:process-interrupt mp::process-name mp:process-wait-function mp:process-run-reasons mp:process-arrest-reasons mp:process-whostate mp:without-interrupts mp:process-wait mp::process-active-p )) ) (eval-when (:compile-toplevel :load-toplevel :execute) (export '( *current-process* process-kill process-enable process-disable process-preset process-reset process-interrupt process-name process-wait-function process-run-reasons process-arrest-reasons process-whostate without-interrupts process-wait process-active-p )) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implement missing (and differing) functions ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun make-process (&key (name "Anonymous") reset-action run-reasons arrest-reasons (priority 0) quantum resume-hook suspend-hook initial-bindings run-immediately) (declare (ignore priority quantum reset-action resume-hook suspend-hook run-immediately)) (let ((mp:*process-initial-bindings* initial-bindings)) #+(or lispworks4 lispworks5.0) (mp:create-process name :run-reasons run-reasons :arrest-reasons arrest-reasons) #-(or lispworks4 lispworks5.0) (if arrest-reasons (error "Cannot set arrest-reasons in this version of LispWorks.") (mp:create-process name :run-reasons run-reasons)))) (defun process-run-function (name-or-options preset-function &rest preset-arguments) (let ((process (ctypecase name-or-options (string (make-process :name name-or-options)) (list (apply #'make-process name-or-options))))) (apply #'mp::process-preset process preset-function preset-arguments) (push :enable (mp:process-run-reasons process)) process)) (defun process-property-list (process) (mp:process-plist process)) (defun (setf process-property-list) (new-value process) (setf (mp:process-plist process) new-value)) (defun process-name-to-process (name &optional abbrev) (if abbrev (let ((length (length name))) (dolist (process (mp:list-all-processes)) (when (and (>= (length (process-name process)) length) (string= name (process-name process) :end2 length)) (return process)))) (mp:find-process-from-name (ctypecase name (symbol (symbol-name name)) (string name))))) (defun process-wait-with-timeout (whostate seconds function &rest args) (apply #'mp:process-wait-with-timeout whostate seconds function args)) (defun wait-for-input-available (streams &key (wait-function #'socket::stream-input-available) whostate timeout) (let ((collected-fds nil)) (flet ((fd (stream-or-fd) (typecase stream-or-fd (comm:socket-stream (comm:socket-stream-socket stream-or-fd)) (socket::passive-socket (socket::socket-os-fd stream-or-fd)) (fixnum stream-or-fd))) (collect-fds () (setf collected-fds (remove-if-not wait-function streams)))) #+unix (unwind-protect (progn (dolist (stream-or-fd streams) (mp:notice-fd (fd stream-or-fd))) (if timeout (mp:process-wait-with-timeout (or whostate "Waiting for input") timeout #'collect-fds) (mp:process-wait (or whostate "Waiting for input") #'collect-fds))) (dolist (stream-or-fd streams) (mp:unnotice-fd (fd stream-or-fd)))) #-unix (if timeout (mp:process-wait-with-timeout (or whostate "Waiting for input") timeout #'collect-fds) (mp:process-wait (or whostate "Waiting for input") #'collect-fds))) collected-fds)) (defmacro without-scheduling (&body forms) `(mp:without-preemption ,@forms)) (defun process-allow-schedule (&optional process) (declare (ignore process)) (mp:process-allow-scheduling)) (defun process-revoke-run-reason (process object) (mp:without-preemption (setf (mp:process-run-reasons process) (remove object (mp:process-run-reasons process)))) (when (and (eq process mp:*current-process*) (not mp:*inhibit-scheduling-flag*)) (mp:process-allow-scheduling))) (defun process-add-run-reason (process object) (setf (mp:process-run-reasons process) (pushnew object (mp:process-run-reasons process)))) ;revised version from alain picard (defun invoke-with-timeout (timeout bodyfn timeoutfn) (block timeout (let* ((process mp:*current-process*) (unsheduled? nil) (timer (mp:make-timer #'(lambda () (mp:process-interrupt process #'(lambda () (unless unsheduled? (return-from timeout (funcall timeoutfn))))))))) (mp:schedule-timer-relative timer timeout) (unwind-protect (funcall bodyfn) (without-interrupts (mp:unschedule-timer timer) (setf unsheduled? t)))))) (defmacro with-timeout ((seconds &body timeout-forms) &body body) "Execute BODY; if execution takes more than SECONDS seconds, terminate and evaluate TIMEOUT-FORMS." `(invoke-with-timeout ,seconds #'(lambda () ,@body) #'(lambda () ,@timeout-forms))) (defun current-process () "The current process." mp:*current-process*) (defun interrupt-process (process function &rest args) "Run FUNCTION in PROCESS." (apply #'mp:process-interrupt process function args)) (defun make-process-lock (&key name) (mp:make-lock :name name)) (defmacro with-process-lock ((lock &key norecursive timeout whostate) &body forms) (declare (ignore norecursive)) `(mp:with-lock (,lock ,@(when whostate (list :whostate whostate)) ,@(when timeout (list :timeout timeout))) ,@forms)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/lispworks/acl-socket.lisp000066400000000000000000000335671133377100500270370ustar00rootroot00000000000000;; This package is designed for LispWorks. It implements the ;; ACL-style socket interface on top of LispWorks. (eval-when (:compile-toplevel :load-toplevel :execute) (require "comm")) #+cl-ssl (eval-when (:compile-toplevel :load-toplevel :execute) (ssl-internal::initialize-ssl-library) ) (in-package acl-compat.socket) (define-condition stream-error (error) ((acl-compat.excl::stream :initarg :stream :reader stream-error-stream) (acl-compat.excl::action :initarg :action :reader stream-error-action) (acl-compat.excl::code :initarg :code :reader stream-error-code) (acl-compat.excl::identifier :initarg :identifier :reader stream-error-identifier)) (:report (lambda (condition stream) (format stream "A stream error occured (action=~A identifier=~A code=~A stream=~S)." (stream-error-action condition) (stream-error-identifier condition) (stream-error-code condition) (stream-error-stream condition))))) (define-condition socket-error (stream-error) () (:report (lambda (condition stream) (format stream "A socket error occured (action=~A identifier=~A code=~A stream=~S)." (stream-error-action condition) (stream-error-identifier condition) (stream-error-code condition) (stream-error-stream condition))))) #+unix (defun %socket-error-identifier (code) (case code (32 :x-broken-pipe) (98 :address-in-use) (99 :address-not-available) (100 :network-down) (102 :network-reset) (103 :connection-aborted) (104 :connection-reset) (105 :no-buffer-space) (108 :shutdown) (110 :connection-timed-out) (111 :connection-refused) (112 :host-down) (113 :host-unreachable) (otherwise :unknown))) #+win32 (defun %socket-error-identifier (code) (case code (10048 :address-in-use) (10049 :address-not-available) (10050 :network-down) (10052 :network-reset) (10053 :connection-aborted) (10054 :connection-reset) (10055 :no-buffer-space) (10058 :shutdown) (10060 :connection-timed-out) (10061 :connection-refused) (10064 :host-down) (10065 :host-unreachable) (otherwise :unknown))) (defun socket-error (stream error-code action format-string &rest format-args) (declare (ignore format-string format-args)) ;no valid initargs for this with socket-error (let ((code (if (numberp error-code) error-code #+unix(lw:errno-value)))) (error 'socket-error :stream stream :code code :identifier (if (keywordp error-code) error-code (%socket-error-identifier error-code)) :action action))) (defclass socket () ((passive-socket :type fixnum :initarg :passive-socket :reader socket-os-fd))) (defclass passive-socket (socket) ((element-type :type (member signed-byte unsigned-byte base-char) :initarg :element-type :reader element-type) (port :type fixnum :initarg :port :reader local-port))) (defclass binary-socket-stream (de.dataheaven.chunked-stream-mixin:chunked-stream-mixin comm:socket-stream) ()) (defclass input-binary-socket-stream (binary-socket-stream)()) (defclass output-binary-socket-stream (binary-socket-stream)()) (defclass bidirectional-binary-socket-stream (input-binary-socket-stream output-binary-socket-stream)()) (defmethod comm::socket-error ((stream binary-socket-stream) error-code format-string &rest format-args) (apply #'socket-error stream error-code :IO format-string format-args)) (declaim (inline %reader-function-for-sequence)) (defun %reader-function-for-sequence (sequence) (typecase sequence (string #'read-char) ((array unsigned-byte (*)) #'read-byte) ((array signed-byte (*)) #'read-byte) (otherwise #'read-byte))) ;; Bivalent socket support for READ-SEQUENCE (defmethod gray-stream:stream-read-sequence ((stream input-binary-socket-stream) sequence start end) (stream::read-elements stream sequence start end (%reader-function-for-sequence sequence))) ;; NDL 2004-06-06 -- without this, emit-clp-entity tries writing a string down a binary stream, and LW barfs (defmethod gray-stream:stream-write-sequence ((stream output-binary-socket-stream) (sequence string) start end) (write-string sequence stream :start start :end end)) ;; ACL Gray-Streams Enhancment Generic Functions (defmethod stream-input-fn ((stream input-binary-socket-stream)) (comm:socket-stream-socket stream)) (defmethod stream-output-fn ((stream output-binary-socket-stream)) (comm:socket-stream-socket stream)) (defmethod socket-os-fd ((socket comm:socket-stream)) (comm:socket-stream-socket socket)) (defmethod print-object ((passive-socket passive-socket) stream) (print-unreadable-object (passive-socket stream :type t :identity nil) (format stream "@~d on port ~d" (socket-os-fd passive-socket) (local-port passive-socket)))) (defmethod stream-input-available ((fd fixnum)) (comm::socket-listen fd)) (defmethod stream-input-available ((stream stream::os-file-handle-stream)) (stream-input-available (stream::os-file-handle-stream-file-handle stream))) (defmethod stream-input-available ((stream comm:socket-stream)) (or (comm::socket-listen (comm:socket-stream-socket stream)) (listen stream))) (defmethod stream-input-available ((stream socket::passive-socket)) (comm::socket-listen (socket::socket-os-fd stream))) (defmethod accept-connection ((passive-socket passive-socket) &key (wait t)) (if (or wait (stream-input-available passive-socket)) (make-instance 'bidirectional-binary-socket-stream :socket (comm::get-fd-from-socket (socket-os-fd passive-socket)) :direction :io :element-type (element-type passive-socket)))) (defun %new-passive-socket (local-port) (multiple-value-bind (socket error-location error-code) (comm::create-tcp-socket-for-service local-port) (cond (socket socket) (t (error 'socket-error :action error-location :code error-code :identifier :unknown))))) (defun make-socket (&key (remote-host "localhost") local-port remote-port (connect :active) (format :text) (reuse-address t) &allow-other-keys) (declare (ignore format)) (check-type remote-host string) (ecase connect (:passive (let ((comm::*use_so_reuseaddr* reuse-address)) (make-instance 'passive-socket :port local-port :passive-socket (%new-passive-socket local-port) :element-type '(unsigned-byte 8)))) (:active (handler-case (let ((stream (comm:open-tcp-stream remote-host remote-port :direction :io :element-type '(unsigned-byte 8) :errorp t))) (change-class stream 'bidirectional-binary-socket-stream)) (simple-error (condition) (let ((code (first (last (simple-condition-format-arguments condition))))) (socket-error condition code :connect "~A occured while connecting (~?)" (simple-condition-format-arguments condition)))))))) (defmethod close ((passive-socket passive-socket) &key abort) (declare (ignore abort)) (comm::close-socket (socket-os-fd passive-socket))) ;(declaim (ftype (function ((unsigned-byte 32)) (values simple-string)) ; ipaddr-to-dotted)) (defun ipaddr-to-dotted (ipaddr &key values) ;(declare (type (unsigned-byte 32) ipaddr)) (if ipaddr ;sometimes ipaddr is nil in the log call if client has broken the connection (let ((a (logand #xff (ash ipaddr -24))) (b (logand #xff (ash ipaddr -16))) (c (logand #xff (ash ipaddr -8))) (d (logand #xff ipaddr))) (if values (values a b c d) (format nil "~d.~d.~d.~d" a b c d))) (if values (values 0 0 0 0) "0.0.0.0"))) (defun string-tokens (string) (labels ((get-token (str pos1 acc) (let ((pos2 (position #\Space str :start pos1))) (if (not pos2) (nreverse acc) (get-token str (1+ pos2) (cons (read-from-string (subseq str pos1 pos2)) acc)))))) (get-token (concatenate 'string string " ") 0 nil))) (declaim (ftype (function (string &key (:errorp t)) (values (unsigned-byte 32))) dotted-to-ipaddr)) (defun dotted-to-ipaddr (dotted &key (errorp t)) (declare (string dotted)) (if errorp (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll))) (ignore-errors (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll)))))) (defun ipaddr-to-hostname (ipaddr &key ignore-cache) (declare (ignore ignore-cache)) (multiple-value-bind (name) (comm:get-host-entry (ipaddr-to-dotted ipaddr) :fields '(:name)) name)) (defun lookup-hostname (host &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword in LOOKUP-HOSTNAME not supported.")) (if (stringp host) (multiple-value-bind (addr) (comm:get-host-entry host :fields '(:address)) addr) (dotted-to-ipaddr (ipaddr-to-dotted host)))) (defmethod remote-host ((socket comm:socket-stream)) (comm:socket-stream-peer-address socket)) (defmethod remote-port ((socket comm:socket-stream)) (multiple-value-bind (host port) (comm:socket-stream-peer-address socket) (declare (ignore host)) port)) (defmethod local-host ((socket comm:socket-stream)) (multiple-value-bind (host port) (comm:socket-stream-address socket) (declare (ignore port)) host)) (defmethod local-port ((socket comm:socket-stream)) (multiple-value-bind (host port) (comm:socket-stream-address socket) (declare (ignore host)) port)) (defun socket-control (stream &key (output-chunking nil oc-p) output-chunking-eof (input-chunking nil ic-p)) (when oc-p (when output-chunking (de.dataheaven.chunked-stream-mixin::initialize-output-chunking stream)) (setf (de.dataheaven.chunked-stream-mixin:output-chunking-p stream) output-chunking)) (when output-chunking-eof (de.dataheaven.chunked-stream-mixin::disable-output-chunking stream)) (when ic-p (when input-chunking (de.dataheaven.chunked-stream-mixin::initialize-input-chunking stream)) (setf (de.dataheaven.chunked-stream-mixin:input-chunking-p stream) input-chunking))) #+(and :lispworks4.4 (not :cl-ssl)) (defmethod make-ssl-client-stream ((socket-stream bidirectional-binary-socket-stream) &rest options) (declare (ignore options)) (comm:attach-ssl socket-stream :ssl-ctx t :ssl-side :client) socket-stream) #+(and :lispworks4.4 (not :cl-ssl)) (defun initialize-ssl-library () ;; Dunno how to force load yet (comm:ensure-ssl)) #+(and :lispworks4.4 (not :cl-ssl)) (defmethod make-ssl-server-stream ((socket-stream bidirectional-binary-socket-stream) &key certificate certificate-password) (flet ((ctx-configure-callback (ctx) (comm:ssl-ctx-use-privatekey-file ctx certificate-password comm:SSL_FILETYPE_PEM)) (ssl-configure-callback (ssl) (comm:ssl-use-certificate-file ssl certificate comm:SSL_FILETYPE_PEM))) (comm:attach-ssl socket-stream :ssl-side :server :ctx-configure-callback #'ctx-configure-callback :ssl-configure-callback #'ssl-configure-callback)) socket-stream) ;; SSL support using built-in LispWorks OpenSSL interface (defvar *certificate-ctx-map* (make-hash-table :test 'equal)) (defvar *certificate-ctx-map-lock* (mp:make-lock)) (defvar *share-ssl-ctx-p* nil) ; needs to remain as NIL for ACL compatibility? (defun ensure-ssl-ctx-for-certificate (certificate-file key certificate-password) (if *share-ssl-ctx-p* (mp:with-lock (*certificate-ctx-map-lock*) (or (gethash certificate-file *certificate-ctx-map*) (setf (gethash certificate-file *certificate-ctx-map*) (make-ssl-ctx-for-certificate certificate-file key certificate-password)))) (make-ssl-ctx-for-certificate certificate-file key certificate-password))) (defun make-ssl-ctx-for-certificate (certificate-file key certificate-password) (let ((ssl-ctx (comm:make-ssl-ctx :ssl-side :server))) (when certificate-password (comm:set-ssl-ctx-password-callback ssl-ctx :password certificate-password)) (comm:ssl-ctx-use-certificate-chain-file ssl-ctx (namestring certificate-file)) (comm:ssl-ctx-use-rsaprivatekey-file ssl-ctx (namestring (or key certificate-file)) comm:ssl_filetype_pem) ;; (comm:set-ssl-ctx-dh ssl-ctx :filename dh-file) ssl-ctx)) (defmethod make-ssl-server-stream ((stream comm:socket-stream) &key certificate key certificate-password ;; method verify max-depth ; client cert options ;; ca-file ca-directory ; not implemented yet ) (let ((ctx (ensure-ssl-ctx-for-certificate certificate key certificate-password))) (comm:attach-ssl stream :ssl-side :server :ssl-ctx ctx) ;; Return the same stream -- is this allowed? stream)) (provide 'acl-socket) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/lispworks/acl-sys.lisp000066400000000000000000000014151133377100500263500ustar00rootroot00000000000000(in-package :sys) (let ((*handle-warn-on-redefinition* :warn)) ; (*packages-for-warn-on-redefinition* nil)) (defun command-line-arguments () system:*line-arguments-list*) (defun command-line-argument (n) (nth n system:*line-arguments-list*)) (defun reap-os-subprocess (&key (wait nil)) (declare (ignore wait)) nil) (export 'command-line-arguments) (export 'command-line-argument) (export 'reap-os-subprocess)) ;; Franz uses the MSWINDOWS feature conditional in some of their code; ;; thus, under Windows, ACL-COMPAT should probably push MSWINDOWS ;; onto the *features* list when it detects the presence of WIN32 ;; under Lispworks. #+WIN32 (eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :mswindows *features*)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/lw-buffering.lisp000066400000000000000000000242011133377100500253250ustar00rootroot00000000000000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; LW Style Buffer Protocol for other Lisps ;;; ;;; So far only 8bit byte and character IO works ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (in-package :gray-stream) (defvar *default-input-buffer-size* 8192) (defvar *default-output-buffer-size* 8192) (eval-when (:compile-toplevel :load-toplevel :execute) (defstruct buffer-state (input-buffer (make-array *default-input-buffer-size* :element-type '(unsigned-byte 8)) :type (simple-array (unsigned-byte 8) (*))) (input-index nil) (input-limit *default-input-buffer-size* :type fixnum) (output-buffer (make-array *default-output-buffer-size* :element-type '(unsigned-byte 8)) :type (simple-array (unsigned-byte 8) (*))) (output-index 0) (output-limit *default-output-buffer-size* :type fixnum))) ;; Can be used to implement resourcing of buffers later (defun %allocate-buffer-state (&optional (input-limit *default-input-buffer-size*) (output-limit *default-output-buffer-size*)) (declare (ignore input-limit output-limit)) (make-buffer-state)) (defun %deallocate-buffer-state (state) (declare (ignore state))) ;; Can be used to implement unbuffered encapsulating streams later (defclass native-lisp-stream-mixin () ((lisp-stream :initarg :lisp-stream :reader native-lisp-stream)) (:documentation "Stream mixin that encapsulates a native stream.")) (defclass buffered-stream-mixin (native-lisp-stream-mixin) ((buffer-state :initform (%allocate-buffer-state))) (:documentation "Stream mixin that provides buffering for a native lisp stream.")) ;; fundamental-bivalent-xxx-streams can be used to implement buffered ;; and unbuffered bivalent streams. At the moment, we only implement ;; buffered ones. (defclass fundamental-bivalent-input-stream (fundamental-character-input-stream fundamental-binary-input-stream) ()) (defclass fundamental-bivalent-output-stream (fundamental-character-output-stream fundamental-binary-output-stream) ()) (defclass buffered-bivalent-input-stream (buffered-stream-mixin fundamental-bivalent-input-stream) ()) (defclass buffered-bivalent-output-stream (buffered-stream-mixin fundamental-bivalent-output-stream) ()) (defclass buffered-bivalent-stream (buffered-bivalent-input-stream buffered-bivalent-output-stream) ()) (defmacro with-stream-output-buffer ((buffer index limit) stream &body forms) (let ((state (gensym "BUFFER-STATE-"))) `(let ((,state (slot-value ,stream 'buffer-state))) (symbol-macrolet ((,buffer ,(list 'buffer-state-output-buffer state)) (,index ,(list 'buffer-state-output-index state)) (,limit ,(list 'buffer-state-output-limit state))) ,@forms)))) ;;; Encapsulated native streams (defmethod close ((stream native-lisp-stream-mixin) &key abort) (close (native-lisp-stream stream) :abort abort)) (defmethod stream-listen ((stream native-lisp-stream-mixin)) (listen (native-lisp-stream stream))) (defmethod open-stream-p ((stream native-lisp-stream-mixin)) (common-lisp::open-stream-p (native-lisp-stream stream))) (defmethod stream-clear-output ((stream native-lisp-stream-mixin)) (clear-output (native-lisp-stream stream))) ;;; Input streams (declaim (inline %reader-function-for-sequence)) (defun %reader-function-for-sequence (sequence) (typecase sequence (string #'read-char) ((array unsigned-byte (*)) #'read-byte) ((array signed-byte (*)) #'read-byte) (otherwise #'read-byte))) (defun read-elements (socket-stream sequence start end reader-fn) (let* ((len (length sequence)) (chars (- (min (or end len) len) start))) (loop for i upfrom start repeat chars for char = (funcall reader-fn socket-stream) if (eq char :eof) do (return-from read-elements i) do (setf (elt sequence i) char)) (+ start chars))) (defmacro with-stream-input-buffer ((buffer index limit) stream &body forms) (let ((state (gensym "BUFFER-STATE-"))) `(let ((,state (slot-value ,stream 'buffer-state))) (symbol-macrolet ((,buffer ,(list 'buffer-state-input-buffer state)) (,index ,(list 'buffer-state-input-index state)) (,limit ,(list 'buffer-state-input-limit state))) ,@forms)))) (defgeneric stream-fill-buffer (stream)) (defmethod stream-fill-buffer ((stream buffered-stream-mixin)) ;; Implement b/nb semantics: block until at least one byte is read, ;; but not until the whole buffer is filled. This means it takes at ;; most n calls to this function to fill a buffer of length n, even ;; with a slow connection. (with-stream-input-buffer (buffer index limit) stream (let* ((the-stream (native-lisp-stream stream)) (read-bytes (loop with byte for n-read from 0 below limit while (and (if (< 0 n-read) (listen the-stream) t) (setf byte (read-byte the-stream nil nil))) do (setf (aref buffer n-read) byte) count t))) (if (zerop read-bytes) nil (setf index 0 limit read-bytes))))) (defmethod stream-listen ((stream buffered-stream-mixin)) (with-stream-input-buffer (buffer index limit) stream (or (and index (< index limit)) (call-next-method)))) (defmethod stream-read-byte ((stream buffered-bivalent-input-stream)) (with-stream-input-buffer (buffer index limit) stream (unless (and index (< index limit)) (when (null (stream-fill-buffer stream)) (return-from stream-read-byte :eof))) (prog1 (aref buffer index) (incf index)))) (defmethod stream-read-char ((stream buffered-bivalent-input-stream)) (let ((byte (stream-read-byte stream))) (if (eq byte :eof) :eof (code-char byte)))) (defmethod stream-read-char-no-hang ((stream buffered-bivalent-input-stream)) (if (listen stream) (read-char stream) nil)) (defmethod stream-unread-char ((stream buffered-bivalent-input-stream) character) (with-stream-input-buffer (buffer index limit) stream (let ((new-index (1- index))) (when (minusp new-index) (error "Cannot unread char ~A" character)) (setf (aref buffer new-index) (char-code character) index new-index))) nil) (defmethod stream-peek-char ((stream buffered-bivalent-input-stream)) (let ((char (stream-read-char stream))) (unless (eq char :eof) (stream-unread-char stream char)) char)) (defmethod stream-read-line ((stream buffered-bivalent-input-stream)) (let ((res (make-array 80 :element-type 'character :fill-pointer 0))) (loop (let ((ch (stream-read-char stream))) (cond ((eq ch :eof) (return (values (copy-seq res) t))) ((char= ch #\Linefeed) (return (values (copy-seq res) nil))) (t (vector-push-extend ch res))))))) (defmethod stream-read-sequence ((stream buffered-bivalent-input-stream) sequence &optional start end) (read-elements stream sequence start end (%reader-function-for-sequence sequence))) ;;(defmethod stream-clear-input ((stream buffered-bivalent-input-stream)) ;; (clear-input (native-lisp-stream stream))) (defmethod stream-element-type ((stream fundamental-bivalent-input-stream)) '(or character (unsigned-byte 8))) ;;; Output streams (declaim (inline %writer-function-for-sequence)) (defun %writer-function-for-sequence (sequence) (typecase sequence (string #'stream-write-char) ((array unsigned-byte (*)) #'stream-write-byte) ((array signed-byte (*)) #'stream-write-byte) (otherwise #'stream-write-byte))) (defun write-elements (stream sequence start end writer-fn) (let* ((len (length sequence)) (start (or start 0)) (end (or end len))) (assert (<= 0 start end len)) (etypecase sequence (simple-vector (loop for i from start below end do (funcall writer-fn stream (svref sequence i)))) (vector (loop for i from start below end do (funcall writer-fn stream (aref sequence i)))) (list (loop for i from start below end for c in (nthcdr start sequence) do (funcall writer-fn stream c)))))) (defgeneric stream-write-buffer (stream buffer start end)) (defmethod stream-write-buffer ((stream buffered-stream-mixin) buffer start end) (let ((lisp-stream (native-lisp-stream stream))) (write-sequence buffer lisp-stream :start start :end end))) (defgeneric stream-flush-buffer (stream)) (defmethod stream-flush-buffer ((stream buffered-stream-mixin)) (with-stream-output-buffer (buffer index limit) stream (when (plusp index) (stream-write-buffer stream buffer 0 index) (setf index 0)))) (defmethod stream-write-byte ((stream buffered-bivalent-output-stream) byte) (with-stream-output-buffer (buffer index limit) stream (unless (< index limit) (stream-flush-buffer stream)) (setf (aref buffer index) byte) (incf index))) (defmethod stream-write-char ((stream buffered-bivalent-output-stream) character) (stream-write-byte stream (char-code character))) (defmethod stream-write-string ((stream buffered-bivalent-output-stream) string &optional (start 0) end) (write-elements stream string start end #'stream-write-char)) (defmethod stream-write-sequence ((stream buffered-stream-mixin) sequence &optional (start 0) end) (write-elements stream sequence start end (%writer-function-for-sequence sequence))) (defmethod stream-element-type ((stream fundamental-bivalent-output-stream)) '(or character (unsigned-byte 8))) (defmethod stream-line-column ((stream fundamental-bivalent-output-stream)) nil) (defmethod stream-finish-output ((stream buffered-bivalent-output-stream)) (stream-flush-buffer stream) (finish-output (native-lisp-stream stream))) (defmethod stream-force-output ((stream buffered-bivalent-output-stream)) (stream-flush-buffer stream) (force-output (native-lisp-stream stream))) (defmethod stream-clear-output ((stream buffered-bivalent-output-stream)) (with-stream-output-buffer (buffer index limit) stream (setf index 0 limit 0)) (call-next-method) ; Clear native stream also ) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/mcl/000077500000000000000000000000001133377100500226215ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/mcl/acl-excl.lisp000066400000000000000000000150401133377100500252020ustar00rootroot00000000000000;;;; ;;;; ACL-COMPAT - EXCL ;;;; ;;;; Implementation-specific parts of acl-compat.excl (see ;;;; acl-excl-common.lisp) (in-package :acl-compat.excl) ;#-openmcl ;(defun fixnump (x) ; (ccl::fixnump x)) #-openmcl (import 'ccl::fixnump) #+openmcl (defun filesys-inode (path) (or (nth-value 4 (ccl::%stat (ccl::native-translated-namestring path))) (error "path ~s does not exist" path))) (defun cl-internal-real-time () (round (/ (get-internal-real-time) 1000))) (defun stream-input-fn (stream) stream) (defun filesys-type (file-or-directory-name) (if (ccl:directory-pathname-p file-or-directory-name) :directory (if (probe-file file-or-directory-name) :file nil))) (defmacro atomically (&body forms) `(ccl:without-interrupts ,@forms)) (defmacro without-package-locks (&body forms) `(progn ,@forms)) (define-condition stream-error (error) ((stream :initarg :stream :reader stream-error-stream) (action :initarg :action :initform nil :reader stream-error-action) (code :initarg :code :initform nil :reader stream-error-code) (identifier :initarg :identifier :initform nil :reader stream-error-identifier)) (:report (lambda (condition stream) (format stream "A stream error occured (action=~A identifier=~A code=~A stream=~S)." (stream-error-action condition) (stream-error-identifier condition) (stream-error-code condition) (stream-error-stream condition))))) (define-condition socket-error (stream-error) () (:report (lambda (condition stream) (format stream "A socket error occured (action=~A identifier=~A code=~A stream=~S)." (stream-error-action condition) (stream-error-identifier condition) (stream-error-code condition) (stream-error-stream condition))))) ;! Need to figure out what to do here (defun fasl-read (filename) (declare (ignore filename)) (error "fasl-read not implemented for MCL.") ) (defun fasl-write (data stream opt) (declare (ignore data stream opt)) (error "fasl-write not implemented for MCL.") ) (defmacro schedule-finalization (object function) `(ccl:terminate-when-unreachable ,object ,function)) (defun run-shell-command (program &key input output error-output separate-streams if-input-does-not-exist if-output-exists if-error-output-exists wait environment show-window) (declare (ignore show-window)) ;; KLUDGE: split borrowed from asdf, this shouldn't be done -- it ;; would be better to use split-sequence or define one ourselves ... ;; TODO: On Unix, acl also handles a vector of simple-strings as ;; value for program, with different semantics. (let* ((program-and-arguments (delete "" (asdf::split program) :test #'string=)) (program (car program-and-arguments)) (arguments (cdr program-and-arguments))) (when environment #-unix (error "Don't know how to run program in an environment.") (setf arguments (append (list "-i") (loop for (name . value) in environment collecting (concatenate 'string name "=" value)) (list program) arguments)) (setf program "env")) (let* ((process (run-program program arguments :input input :if-input-does-not-exist if-input-does-not-exist :output output :if-output-exists if-output-exists :error error-output :if-error-exists if-error-output-exists :wait wait)) (in-stream (external-process-input-stream process)) (out-stream (external-process-output-stream process)) (err-stream (external-process-error-stream process)) (pid (external-process-id process))) (cond ;; one value: exit status (wait (nth-value 1 (external-process-status process))) ;; four values: i/o/e stream, pid (separate-streams (values (if (eql input :stream) in-stream nil) (if (eql output :stream) out-stream nil) (if (eql error-output :stream) err-stream nil) pid)) ;; three values: normal stream, error stream, pid (t (let ((normal-stream (cond ((and (eql input :stream) (eql output :stream)) (make-two-way-stream in-stream out-stream)) ((eql input :stream) in-stream) ((eql output :stream) out-stream) (t nil))) (error-stream (if (eql error-output :stream) err-stream nil))) (values normal-stream error-stream pid))))))) (defun string-to-octets (string &key (null-terminate t) (start 0) end mb-vector make-mb-vector? (external-format :default)) "This function returns a lisp-usb8-vector and the number of bytes copied." (declare (ignore external-format)) ;; The end parameter is different in ACL's lambda list, but this ;; variant lets us give an argument :end nil explicitly, and the ;; right thing will happen (unless end (setf end (length string))) (let* ((number-of-octets (if null-terminate (1+ (- end start)) (- end start))) (mb-vector (cond ((and mb-vector (>= (length mb-vector) number-of-octets)) mb-vector) ((or (not mb-vector) make-mb-vector?) (make-array (list number-of-octets) :element-type '(unsigned-byte 8) :initial-element 0)) (t (error "Was given a vector of length ~A, ~ but needed at least length ~A." (length mb-vector) number-of-octets))))) (declare (type (simple-array (unsigned-byte 8) (*)) mb-vector)) (loop for from-index from start below end for to-index upfrom 0 do (progn (setf (aref mb-vector to-index) (char-code (aref string from-index))))) (when null-terminate (setf (aref mb-vector (1- number-of-octets)) 0)) (values mb-vector number-of-octets))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/mcl/acl-mp.lisp000066400000000000000000000141731133377100500246710ustar00rootroot00000000000000;;; This file implements the process functions for AllegroServe in MCL. ;;; Based on the the work done for cmucl and Lispworks. ;;; ;;; John DeSoi, Ph.D. desoi@users.sourceforge.net (in-package :acl-compat.mp) (eval-when (:compile-toplevel :load-toplevel :execute) ; existing stuff from ccl we can reuse directly (shadowing-import '(ccl:*current-process* ccl::lock ccl:process-allow-schedule ccl:process-name ccl:process-preset #-openmcl-native-threads ccl:process-run-reasons ccl:process-wait ccl:process-wait-with-timeout ccl:without-interrupts)) ) (eval-when (:compile-toplevel :load-toplevel :execute) (export '(*current-process* lock process-allow-schedule process-name process-preset process-run-reasons process-wait process-wait-with-timeout without-interrupts)) ) (eval-when (:compile-toplevel :load-toplevel :execute) (defmacro without-scheduling (&body forms) `(ccl:without-interrupts ,@forms)) #| ; more ideas stolen from acl-mp-lw.lisp (defun invoke-with-timeout (seconds bodyfn timeoutfn) (block timeout (let* ((process *current-process*) (timer (ccl:process-run-function "with-timeout-timer" #'(lambda () (sleep seconds) (ccl:process-interrupt process #'(lambda () (return-from timeout (funcall timeoutfn)))))))) (unwind-protect (funcall bodyfn) (ccl:process-kill timer))))) |# (defun invoke-with-timeout (seconds bodyfn timeoutfn) (block timeout (let* ((timer (ccl::make-timer-request seconds #'(lambda () (return-from timeout (funcall timeoutfn)))))) (ccl::enqueue-timer-request timer) (unwind-protect (funcall bodyfn) (ccl::dequeue-timer-request timer))))) (defmacro with-timeout ((seconds &body timeout-forms) &body body) "Execute BODY; if execution takes more than SECONDS seconds, terminate and evaluate TIMEOUT-FORMS." `(invoke-with-timeout ,seconds #'(lambda () ,@body) #'(lambda () ,@timeout-forms))) #+openmcl-native-threads (progn ;;; The :INITIAL-BINDINGS arg to process creation functions seems to be ;;; quoted, even when it appears in a list (as in the case of ;;; (process-run-function )) By the time that percolates down ;;; to OpenMCL's process creation functions, it should lose the quote. ;;; ;;; Perhaps I imagined that ... ;;; (defun ccl::openmcl-fix-initial-bindings (initial-bindings) (if (and (consp initial-bindings) (eq (car initial-bindings) 'quote)) (cadr initial-bindings) initial-bindings)) ) #-openmcl-native-threads (defmacro process-revoke-run-reason (process reason) `(ccl:process-disable-run-reason ,process ,reason) ) #-openmcl-native-threads (defmacro process-add-run-reason (process reason) `(ccl:process-enable-run-reason ,process ,reason) ) (defmacro make-process-lock (&key name) (if name `(ccl:make-lock ,name) `(ccl:make-lock))) (defmacro with-process-lock ((lock &key norecursive timeout whostate) &body forms) (declare (ignore norecursive whostate timeout)) `(ccl:with-lock-grabbed (,lock) ,@forms)) (defmacro process-kill (process) `(progn #-openmcl-native-threads (unless (ccl:process-active-p ,process) ;won't die unless enabled (ccl:process-reset-and-enable ,process) ) (ccl:process-kill ,process))) ) (defun process-active-p (process) (ccl::process-active-p process)) (defun interrupt-process (process function &rest args) "Run FUNCTION in PROCESS." (apply #'ccl:process-interrupt process function args)) (defun current-process () "The current process." ccl:*current-process*) ;property list implementation from acl-mp-cmu.lisp (defvar *process-plists* (make-hash-table :test #'eq) "maps processes to their plists. See the functions process-plist, (setf process-plist).") (defun process-property-list (process) (gethash process *process-plists*)) (defun (setf process-property-list) (new-value process) (setf (gethash process *process-plists*) new-value)) ; from acl-mp-lw.lisp (defun make-process (&key (name "Anonymous") reset-action run-reasons arrest-reasons (priority 0) quantum resume-hook suspend-hook initial-bindings run-immediately) (declare (ignore priority quantum reset-action resume-hook suspend-hook run-immediately)) #-openmcl-native-threads (declare (ignore initial-bindings)) ;! need separate lexical bindings for each process? #+openmcl-native-threads (declare (ignore run-reasons arrest-reasons)) ;(let ((acl-mp:*process-initial-bindings* initial-bindings)) #-openmcl-native-threads (ccl:make-process name :run-reasons run-reasons :arrest-reasons arrest-reasons) #+openmcl-native-threads (ccl:make-process name :initial-bindings (ccl::openmcl-fix-initial-bindings initial-bindings))) (defun process-run-function (name-or-options preset-function &rest preset-arguments) (let ((process (ctypecase name-or-options (string (acl-mp:make-process :name name-or-options)) (list (apply #'acl-mp:make-process name-or-options))))) (apply #'acl-mp:process-preset process preset-function preset-arguments) #+openmcl-native-threads (ccl:process-enable process) #-openmcl-native-threads (process-add-run-reason process :enable) process)) ;;; Busy-waiting ... (defun wait-for-input-available (streams &key (wait-function #'ccl:stream-listen) whostate timeout) (let ((collected-fds nil)) (flet ((collect-fds () (setf collected-fds (remove-if-not wait-function streams)))) (if timeout (process-wait-with-timeout (or whostate "Waiting for input") timeout #'collect-fds) (process-wait (or whostate "Waiting for input") #'collect-fds))) collected-fds)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/mcl/acl-socket-mcl.lisp000066400000000000000000000212251133377100500263120ustar00rootroot00000000000000;;; MCL layer for ACL sockets. ;;; Based on acl-socket-cmu.lisp and acl-socket-lw.lisp. ;;; ;;; John DeSoi, Ph.D. desoi@users.sourceforge.net (defpackage :acl-compat.socket (:nicknames :socket :acl-socket) (:use :common-lisp) (:export #:make-socket #:accept-connection #:ipaddr-to-dotted #:dotted-to-ipaddr #:ipaddr-to-hostname #:lookup-hostname #:remote-host #:remote-port #:local-host #:local-port #:socket-control )) (in-package :socket) (eval-when (:compile-toplevel :load-toplevel :execute) (require :opentransport) ;OpenTransport.lisp does not export anything, so do this to make it look a bit cleaner. (import '(ccl::open-tcp-stream ccl::opentransport-tcp-stream ccl::opentransport-binary-tcp-stream ccl::stream-local-port ccl::stream-local-host ccl::stream-local-port ccl::stream-remote-host ccl::stream-remote-port ccl::inet-host-name ccl::tcp-host-address ) ) (defmacro connection-state (s) `(ccl::opentransport-stream-connection-state ,s)) (defmacro connection-established (s) `(eq :dataxfer (connection-state ,s)) ) ) ;;; There is a bug in MCL (4.3.1 tested) where read-sequence and ;;; write-sequence fail with binary tcp streams. These two methods ;;; provide a work-around. #-carbon-compat ;should be fixed starting with first carbon version (4.3.5) (defmethod ccl:stream-write-sequence ((s opentransport-binary-tcp-stream) (sequence ccl::simple-unsigned-byte-vector) &key (start 0) end) (ccl::stream-write-vector s sequence start (or end (length sequence))) s) #-carbon-compat ;should be fixed starting with first carbon version (4.3.5) (defmethod ccl:stream-read-sequence ((s opentransport-binary-tcp-stream) (sequence ccl::simple-unsigned-byte-vector) &key (start 0) (end (length sequence))) (ccl::stream-read-bytes-to-vector s sequence (- end start) start) end) (defmethod port ((stream opentransport-tcp-stream)) (stream-local-port stream) ) (defmethod local-host ((s opentransport-tcp-stream)) (stream-local-host s)) (defmethod local-port ((s opentransport-tcp-stream)) (stream-local-port s)) (defmethod remote-host ((s opentransport-tcp-stream)) (stream-remote-host s)) (defmethod remote-port ((s opentransport-tcp-stream)) (stream-remote-port s)) ;? copied from lispworks - don't think it applies to mcl (defmethod fd ((s opentransport-tcp-stream)) (declare (ignore s)) 42) (defvar *passive-socket-listener-count* 10 "Default number of listen streams to use.") ; With ACL, an unlimited number of connections can be made to the same passive ; socket instance. Nothing like that here, so we have to create our own stream ; listener to create the "real" sockets as connections are made. ; Create a class to monitor streams so we have a data structure to pass to process-wait (defclass passive-socket (stream) ;inherit stream so we can handle close ((port :documentation "Port we are listening on." :initform 80 :initarg :port :reader local-port) (element-type :documentation "Stream element type." :initarg :element-type :initform '(unsigned-byte 8)) (count :documentation "Number of listening streams to monitor." :initform *passive-socket-listener-count*) (streams :documentation "Array of listen streams." :initform nil) (index :documentation "Index of the last listen stream checked." :initform *passive-socket-listener-count*) (connect-index :documentation "Index of a connected stream, next for processing." :initform nil) ) (:documentation "Class used to manage listening streams and connections.") ) (defmethod initialize-instance :after ((listener passive-socket) &rest initargs) (declare (ignore initargs)) (with-slots (streams count port element-type) listener (setf streams (make-array count :initial-element nil :adjustable t)) (dotimes (i count) (setf (elt streams i) (new-listen-stream listener)) ) ) ) (defmethod ccl:stream-close ((listener passive-socket)) (with-slots (streams count) listener (dotimes (i count) (close (elt streams i))) (setf count 0))) (defmethod new-listen-stream ((listener passive-socket)) (with-slots (port element-type) listener (open-tcp-stream nil port ;use nil host to get a passive connection :element-type element-type) ) ) (defmethod local-host ((listener passive-socket)) (with-slots (streams count) listener (when (> count 0) (local-host (elt streams 0))))) ; See if one of the streams is established. (defmethod find-connection-index ((listener passive-socket)) (with-slots (count streams index connect-index) listener (let ((next (if (< (1+ index) count) (1+ index) 0))) (when (connection-established (elt streams next)) (setf index next connect-index next) connect-index)))) (defmethod process-connected-stream ((listener passive-socket)) (with-slots (streams connect-index) listener (if (null connect-index) nil (let ((s (elt streams connect-index))) ;return the connected stream and set a new one (setf (elt streams connect-index) (new-listen-stream listener)) (setf connect-index nil) s) ) ) ) ;! future - determine how many connects we are getting an dynamically increase the number ; of listeners if necessary. (defmethod accept-connection ((listener passive-socket) &key (wait t)) (if wait (ccl:process-wait "accept connection..." #'find-connection-index listener) ;apply repeatedly with process wait (find-connection-index listener) ) (process-connected-stream listener) ) (defun make-socket (&key (remote-host "localhost") local-port remote-port (connect :active) (format :text) &allow-other-keys) (let ((element-type (ecase format (:text 'base-char) (:binary 'signed-byte) (:bivalent 'unsigned-byte)))) (ecase connect (:passive (make-instance 'passive-socket :port local-port :element-type element-type :direction :io)) (:active (let ((host (if (integerp remote-host) ;aparently the acl version also accepts an integer (ipaddr-to-dotted remote-host) remote-host))) (check-type host string) (open-tcp-stream host remote-port :element-type element-type)))))) (declaim (ftype (function ((unsigned-byte 32)) (values simple-string)) ipaddr-to-dotted)) (defun ipaddr-to-dotted (ipaddr &key values) (declare (type (unsigned-byte 32) ipaddr)) (let ((a (logand #xff (ash ipaddr -24))) (b (logand #xff (ash ipaddr -16))) (c (logand #xff (ash ipaddr -8))) (d (logand #xff ipaddr))) (if values (values a b c d) (format nil "~d.~d.~d.~d" a b c d)))) (defun string-tokens (string) (labels ((get-token (str pos1 acc) (let ((pos2 (position #\Space str :start pos1))) (if (not pos2) (nreverse acc) (get-token str (1+ pos2) (cons (read-from-string (subseq str pos1 pos2)) acc)))))) (get-token (concatenate 'string string " ") 0 nil))) (declaim (ftype (function (string &key (:errorp t)) (values (unsigned-byte 32))) dotted-to-ipaddr)) (defun dotted-to-ipaddr (dotted &key (errorp t)) (declare (string dotted)) (if errorp (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll))) (ignore-errors (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll)))))) (defun ipaddr-to-hostname (ipaddr &key ignore-cache) (declare (ignore ignore-cache)) (inet-host-name ipaddr) ) (defun lookup-hostname (host &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword in LOOKUP-HOSTNAME not supported.")) (if (stringp host) (tcp-host-address host) (dotted-to-ipaddr (ipaddr-to-dotted host)))) (defun socket-control (stream &key output-chunking output-chunking-eof input-chunking) (declare (ignore stream)) (warn "SOCKET-CONTROL function not implemented.") (when (or output-chunking output-chunking-eof input-chunking) (error "Chunking is not yet supported in MCL. Restart the server with argument :chunking nil (turns chunking off).") ) ) (provide 'acl-socket) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/mcl/acl-socket-openmcl.lisp000066400000000000000000000116461133377100500272020ustar00rootroot00000000000000;;; OpenMCL layer for ACL sockets. ;;; Most everything is already there, just needs to be in the socket package. ;;; ;;; John DeSoi, Ph.D. desoi@users.sourceforget.net (in-package :acl-compat.socket) (eval-when (:compile-toplevel :load-toplevel :execute) (shadowing-import '(;ccl:make-socket ; use our own version ccl:accept-connection ccl:dotted-to-ipaddr ccl:ipaddr-to-hostname ccl:lookup-hostname ccl:remote-host ccl:remote-port ccl:local-host ccl:local-port)) ) (eval-when (:compile-toplevel :load-toplevel :execute) (export '(accept-connection ipaddr-to-dotted dotted-to-ipaddr ipaddr-to-hostname lookup-hostname remote-host remote-port local-host local-port socket-control)) ) (defclass server-socket () ((socket :initarg :socket :reader socket :initform (error "No value supplied for socket")) (port :initarg :port :reader port :initform (error "No value supplied for port")))) (defmethod print-object ((socket server-socket) stream) (print-unreadable-object (socket stream :type t :identity nil) (format stream "listening on port ~d" (port socket)))) (defmethod accept-connection ((server-socket server-socket) &key (wait t)) "Return a bidirectional stream connected to socket." (let ((stream (accept-connection (socket server-socket) :wait wait))) (when stream (make-chunked-stream stream)))) (defun make-socket (&rest args &key (connect :active) port &allow-other-keys) "Return a stream connected to remote-host if connect is :active, or something listening on local-port that can be fed to accept-connection if connect is :passive. " (let ((socket-or-stream (apply #'ccl:make-socket args))) (if (eq connect :active) (make-chunked-stream socket-or-stream) (make-instance 'server-socket :socket socket-or-stream :port port)))) (defmethod close ((server-socket server-socket) &key abort) "Kill a passive (listening) socket. (Active sockets are actually streams and handled by their close methods." (declare (ignore abort)) (close (socket server-socket))) (defmethod local-host ((server-socket server-socket)) (local-host (socket server-socket))) (defmethod local-port ((server-socket server-socket)) (local-port (socket server-socket))) (defmethod ccl:stream-write-vector ((stream gray-stream::buffered-bivalent-stream) vector start end) (declare (fixnum start end)) (let ((fn (gray-stream::%writer-function-for-sequence vector))) (do* ((i start (1+ i))) ((= i end)) (declare (fixnum i)) (funcall fn stream (ccl:uvref vector i))))) (defmethod ccl:stream-read-vector ((stream gray-stream::buffered-bivalent-stream) vector start end) (declare (fixnum start end)) (let ((fn (gray-stream::%reader-function-for-sequence vector))) (do* ((i start (1+ i))) ((= i end) end) (declare (fixnum i)) (let* ((b (funcall fn stream))) (if (eq b :eof) (return i) (setf (ccl:uvref vector i) b)))))) (defclass chunked-stream (de.dataheaven.chunked-stream-mixin::chunked-stream-mixin gray-stream::buffered-bivalent-stream) ((plist :initarg :plist :accessor stream-plist))) (defun make-chunked-stream (lisp-stream &key plist) (make-instance 'chunked-stream :lisp-stream lisp-stream :plist plist)) (defmethod local-host ((chunked-stream chunked-stream)) (local-host (gray-stream::native-lisp-stream chunked-stream))) (defmethod local-port ((chunked-stream chunked-stream)) (local-port (gray-stream::native-lisp-stream chunked-stream))) (defmethod remote-host ((chunked-stream chunked-stream)) (remote-host (gray-stream::native-lisp-stream chunked-stream))) (defmethod remote-port ((chunked-stream chunked-stream)) (remote-port (gray-stream::native-lisp-stream chunked-stream))) (defun socket-control (stream &key (output-chunking nil oc-p) output-chunking-eof (input-chunking nil ic-p)) (when oc-p (when output-chunking (de.dataheaven.chunked-stream-mixin::initialize-output-chunking stream)) (setf (de.dataheaven.chunked-stream-mixin::output-chunking-p stream) output-chunking)) (when output-chunking-eof (de.dataheaven.chunked-stream-mixin::disable-output-chunking stream)) (when ic-p (when input-chunking (de.dataheaven.chunked-stream-mixin::initialize-input-chunking stream)) (setf (de.dataheaven.chunked-stream-mixin::input-chunking-p stream) input-chunking))) ; OpenMCL has a built-in ipaddr-to-dotted. But it appears that sometimes ; the log function is being called after the connection is closed and ; it causes nil to be passed to ipaddr-to-dotted. So we wrap ipaddr-to-dotten ; to ensure only non-nil values are passed. (defun ipaddr-to-dotted (ipaddr &key values) (unless (null ipaddr) (ccl:ipaddr-to-dotted ipaddr :values values))) (provide 'acl-socket) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/mcl/acl-sys.lisp000066400000000000000000000007501133377100500250670ustar00rootroot00000000000000 (in-package :acl-compat.system) (defun command-line-arguments () #+openmcl (ccl::command-line-arguments) #-openmcl nil) (defun command-line-argument (n) #+openmcl (nth n (command-line-arguments)) #-openmcl nil) ;;; On acl, reap-os-subprocess is needed for (run-shell-command ... ;;; :wait nil), but not on OpenMCL. (defun reap-os-subprocess (&key (wait nil)) (declare (ignore wait)) nil) #+nil (export '(command-line-arguments command-line-argument reap-os-subprocess)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/mcl/mcl-stream-fix.lisp000066400000000000000000000033201133377100500263400ustar00rootroot00000000000000 (in-package :ccl) ;;; There are several bugs in MCL functions to read sequences prior to 4.3.5; this fixes them (eval-when (:compile-toplevel :load-toplevel :execute) (let ((ccl:*warn-if-redefine* nil)) (defun %io-buffer-read-bytes-to-vector (io-buffer vector bytes start) (loop with fill-pointer = start with bytes-remaining = bytes until (eql 0 bytes-remaining) while (if (eql 0 (io-buffer-incount io-buffer)) (%io-buffer-advance io-buffer t t) ; eof may be signalled through this -- JCMa 5/13/1999. t) for buffer = (io-buffer-inptr io-buffer) for read-bytes = (min (io-buffer-incount io-buffer) bytes-remaining) do (%copy-ptr-to-ivector buffer 0 vector fill-pointer read-bytes) (incf fill-pointer read-bytes) (%incf-ptr (io-buffer-inptr io-buffer) read-bytes) ;; bug fix from akh on 7/28/2002 (decf bytes-remaining read-bytes) (decf (io-buffer-incount io-buffer) read-bytes) (incf (io-buffer-bytes-read io-buffer) read-bytes))) ;This function is unchanged, but kept for completeness (defun io-buffer-read-bytes-to-vector (io-buffer vector bytes &optional (start 0)) (require-type io-buffer 'io-buffer) (with-io-buffer-locked (io-buffer) (multiple-value-bind (v v-offset) (array-data-and-offset vector) (%io-buffer-read-bytes-to-vector io-buffer v bytes (+ start v-offset))))) (defmethod stream-read-bytes-to-vector ((stream buffered-output-stream-mixin) vector bytes &optional (start 0)) (io-buffer-read-bytes-to-vector (stream-io-buffer stream) vector bytes start)) ;original fuction did not get the buffer from the stream ) )cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/mcl/mcl-timers.lisp000066400000000000000000000104351133377100500255710ustar00rootroot00000000000000;;; mcl-timers contributed by Gary Byers (in-package "CCL") ;;; A simple timer mechanism for MCL/OpenMCL, which uses a ;;; PERIODIC-TASK to check for expired "timer requests". ;;; In MCL and OpenMCL, PERIODIC-TASKS run at specified ;;; intervals via the same preemption mechanism that the ;;; scheduler uses; they run in the execution context of ;;; whatever thread was preempted, and they're assumed to ;;; run pretty quickly. ;;; This code uses doubly-linked-list elements (DLL-NODEs) ;;; to represent a sorted list of "timer requests"; client ;;; processes use timer requests to schedule an interrupt ;;; action at a specified time. A periodic task walks this ;;; list once a second (by default), removing those requests ;;; whose time isn't in the future and interrupting the ;;; corresponding processes. ;;; The number of timer interrupts (ticks) per second. (defmacro ticks-per-second () #+OpenMCL '*ticks-per-second* #-OpenMCL 60) (defun expiration-tick-count (seconds) (+ (round (* seconds (ticks-per-second))) (get-tick-count))) (defstruct (timer-request (:include dll-node) (:constructor %make-timer-request)) expiration-tick ; when the timer expires process ; what process to interrupt function) ; how to interrupt it (defun make-timer-request (seconds-from-now function) (check-type seconds-from-now (and unsigned-byte fixnum)) (check-type function function) (%make-timer-request :expiration-tick (expiration-tick-count seconds-from-now) :process *current-process* :function function)) ;;; the CCL::DEFLOADVAR construct ensures that the variable ;;; will be reinitialized when a saved image is restarted (defloadvar *timer-request-queue* #-openmcl-native-threads (make-dll-header) #+openmcl-native-threads (make-locked-dll-header)) ;;; Insert the timer request before the first element with a later ;;; expiration time (or at the end of the queue if there's no such ;;; element.) (defun enqueue-timer-request (r) (#-openmcl-native-threads without-interrupts #+openmcl-native-threads with-locked-dll-header #+openmcl-native-threads (*timer-request-queue*) (if (dll-node-succ r) ; Already enqueued. r ; Or signal an error. (let* ((r-date (timer-request-expiration-tick r))) (do* ((node *timer-request-queue* next) (next (dll-node-succ node) (dll-node-succ next))) ((or (eq next *timer-request-queue*) (> (timer-request-expiration-tick next) r-date)) (insert-dll-node-after r node))))))) ;;; Remove a timer request. (It's a no-op if the request has already ;;; been removed.) (defun dequeue-timer-request (r) (#-openmcl-native-threads without-interrupts #+openmcl-native-threads with-locked-dll-header #+openmcl-native-threads (*timer-request-queue*) (when (dll-node-succ r) ;enqueued (remove-dll-node r)) r)) ;;; Since this runs in an arbitrary process, it tries to be a little ;;; careful with requests made by the current process (since running ;;; the interrupt function will probably transfer control out of the ;;; periodic task function.) The oldest (hopefully only) request for ;;; the current process is handled after all other pending requests. (defun process-timer-requests () (let* ((now (get-tick-count)) (current-process *current-process*) (current-process-action ())) (#-openmcl-native-threads progn #+openmcl-native-threads with-locked-dll-header #+openmcl-native-threads (*timer-request-queue*) (do-dll-nodes (r *timer-request-queue*) (when (> (timer-request-expiration-tick r) now) (return)) ; Anything remaining is ; in the future. (dequeue-timer-request r) (let* ((proc (timer-request-process r)) (func (timer-request-function r))) (if (eq proc current-process) (if (null current-process-action) (setq current-process-action func)) (process-interrupt (timer-request-process r) (timer-request-function r))))) (when current-process-action (funcall current-process-action))))) (%install-periodic-task 'process-timer-requests ; Name of periodic task 'process-timer-requests ; function to call (ticks-per-second) ; Run once per second ) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/packages.lisp000066400000000000000000000205621133377100500245220ustar00rootroot00000000000000;;;; -*- mode: lisp -*- ;;;; ;;;; Package definitions for acl-compat. ;;;; ;;;; Package names follow their Allegro CL counterparts -- for an ACL ;;;; package foo, acl-compat defines a package acl-compat.foo ;;;; ;;;; Some packages have nicknames, which were used as package names by ;;;; previous versions of paserve and acl-compat. The nicknames are ;;;; deprecated, but are kept for the benefit of people using ;;;; acl-compat in other projects. New projects should use the ;;;; package names starting with "acl-compat.". ;;;; (in-package :common-lisp-user) ;;; general (defpackage :acl-compat.excl (:use #:common-lisp #+cmu #:ext #+clisp #:ext #+sbcl #:sb-ext #+sbcl #:sb-gray #+(or allegro cormanlisp) :excl #+(or mcl openmcl) :ccl ) #+lispworks (:import-from :common-lisp #:fixnump) #+sbcl (:import-from :sb-int #:fixnump) #+sbcl (:import-from :sb-ext #:without-package-locks) #+sbcl (:import-from :sb-ext #:string-to-octets) #+cmu (:import-from :ext #:without-package-locks) #+allegro (:shadowing-import-from :excl #:filesys-size #:filesys-write-date #:intern* #:filesys-type #:atomically #:fast) (:export #:if* #:*initial-terminal-io* #:*cl-default-special-bindings* #:filesys-size #:filesys-write-date #:stream-input-fn #:match-regexp #:compile-regexp #:*current-case-mode* #:intern* #:filesys-type #:errorset #:atomically #:fast #:without-package-locks #:fixnump #+(or lispworks mcl openmcl) #:socket-error #+(or allegro lispworks mcl openmcl) #:run-shell-command #+(or allegro mcl openmcl) #:fasl-read #+(or allegro mcl openmcl) #:fasl-write #+(or allegro cmu scl mcl lispworks openmcl sbcl) #:string-to-octets #+(or allegro cmu scl mcl lispworks openmcl sbcl) #:write-vector )) ;; general (defpackage :acl-compat.mp (:use :common-lisp #+cormanlisp :acl-compat-mp #+allegro :mp) (:nicknames :acl-mp #-cormanlisp :acl-compat-mp) #+allegro (:shadowing-import-from :mp #:process-interrupt #:lock) #+allegro (:shadowing-import-from :excl #:without-interrupts) (:export #:*current-process* ;* #:process-kill ;* #:process-preset ;* #:process-name ;* #:process-wait-function #:process-run-reasons #:process-arrest-reasons #:process-whostate #:without-interrupts #:process-wait #:process-enable #:process-disable #:process-reset #:process-interrupt #:process-run-function ;* #:process-property-list ;* #:without-scheduling ;* #:process-allow-schedule ;* #:make-process ;* #:process-add-run-reason ;* #:process-revoke-run-reason ;* #:process-add-arrest-reason ;* #:process-revoke-arrest-reason ;* #:process-allow-schedule ;* #:with-timeout ;* #:make-process-lock ;* #:with-process-lock ;* #:process-lock #:process-unlock #:current-process #:process-name-to-process #:process-wait-with-timeout #:wait-for-input-available #:process-active-p )) (defpackage :de.dataheaven.chunked-stream-mixin (:use :common-lisp) (:export #:chunked-stream-mixin #:output-chunking-p #:input-chunking-p)) ;; general (defpackage acl-compat.socket (:use #:common-lisp #+(or cmu lispworks scl) #:acl-mp #+(or lispworks cmu)#:acl-compat.excl #+clisp #:socket #+sbcl #:sb-bsd-sockets #+(or lispworks cmu) #:de.dataheaven.chunked-stream-mixin #+cormanlisp #:socket ) #+cl-ssl (:import-from :ssl #:MAKE-SSL-CLIENT-STREAM #:MAKE-SSL-SERVER-STREAM) #+lispworks (:shadow socket-stream stream-error) (:export #+(or lispworks cmu) #:socket #:make-socket #:accept-connection #:ipaddr-to-dotted #:dotted-to-ipaddr #:ipaddr-to-hostname #:lookup-hostname #:remote-host #:remote-port #:local-host #:local-port #:socket-control #+cl-ssl #:make-ssl-client-stream #+cl-ssl #:make-ssl-server-stream #+(and :lispworks4.4 (not :cl-ssl)) #:make-ssl-client-stream #+(and :lispworks4.4 (not :cl-ssl)) #:make-ssl-server-stream #+lispworks #:socket-os-fd ) #-cormanlisp (:nicknames #-(or clisp allegro) socket #-allegro acl-socket)) (defpackage acl-compat.system (:nicknames :acl-compat.sys) (:use :common-lisp) (:export #:command-line-arguments #:command-line-argument #:reap-os-subprocess )) ; these are not all in the ccl package which causes an error #+(and mcl (not openmcl)) (shadowing-import '( fundamental-binary-input-stream fundamental-binary-output-stream fundamental-character-input-stream fundamental-character-output-stream stream-element-type stream-listen stream-read-byte stream-read-char stream-peek-char stream-write-byte stream-write-char stream-read-char-no-hang stream-force-output stream-finish-output stream-clear-input stream-clear-output stream-line-column stream-read-sequence stream-unread-char stream-read-line stream-write-sequence stream-write-string) :ccl) #-cormanlisp (defpackage :gray-stream (:use #:common-lisp) (:import-from #+lispworks :stream #+cmu :lisp #+clisp :gray #+cormanlisp :gray-streams #+(or mcl openmcl) :ccl #+allegro :excl #+sbcl :sb-gray #:fundamental-binary-input-stream #:fundamental-binary-output-stream #:fundamental-character-input-stream #:fundamental-character-output-stream #:stream-element-type #:stream-listen #:stream-read-byte #:stream-read-char #:stream-peek-char #:stream-write-byte #:stream-write-char #:stream-read-char-no-hang #:stream-force-output #:stream-finish-output #:stream-clear-input #:stream-clear-output #:stream-line-column #-(or clisp openmcl) #:stream-read-sequence #:stream-unread-char #:stream-read-line #-(or clisp openmcl) #:stream-write-sequence #:stream-write-string #+lispworks #:stream-write-buffer #+lispworks #:stream-read-buffer #+lispworks #:stream-fill-buffer #+lispworks #:stream-flush-buffer #+lispworks #:with-stream-input-buffer #+lispworks #:with-stream-output-buffer) (:export #:fundamental-binary-input-stream #:fundamental-binary-output-stream #:fundamental-character-input-stream #:fundamental-character-output-stream #:stream-element-type #:stream-listen #:stream-read-byte #:stream-read-char #:stream-write-byte #:stream-write-char #:stream-read-char-no-hang #:stream-force-output #:stream-finish-output #:stream-clear-input #:stream-clear-output #:stream-line-column #-clisp #:stream-read-sequence #:stream-unread-char #:stream-read-line #-clisp #:stream-write-sequence #:stream-write-string #:stream-write-buffer #:stream-read-buffer #:stream-fill-buffer #:stream-flush-buffer #:with-stream-input-buffer #:with-stream-output-buffer)) #+cormanlisp (defpackage :gray-stream (:use #:common-lisp :gray-streams) (:export #:fundamental-binary-input-stream #:fundamental-binary-output-stream #:fundamental-character-input-stream #:fundamental-character-output-stream #:stream-element-type #:stream-listen #:stream-read-byte #:stream-read-char #:stream-write-byte #:stream-write-char #:stream-read-char-no-hang #:stream-force-output #:stream-finish-output #:stream-clear-input #:stream-clear-output #:stream-line-column #:stream-read-sequence #:stream-unread-char #:stream-read-line #:stream-write-sequence #:stream-write-string #:stream-write-buffer #:stream-read-buffer #:stream-fill-buffer #:stream-flush-buffer #:with-stream-input-buffer #:with-stream-output-buffer)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/sbcl/000077500000000000000000000000001133377100500227715ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/sbcl/acl-excl.lisp000066400000000000000000000014471133377100500253600ustar00rootroot00000000000000;;;; ;;;; ACL-COMPAT - EXCL ;;;; ;;;; Implementation-specific parts of acl-compat.excl (see ;;;; acl-excl-common.lisp) (in-package :acl-compat.excl) (defun stream-input-fn (stream) stream) (defun filesys-type (file-or-directory-name) (let ((mode (sb-posix:stat-mode (sb-posix:stat file-or-directory-name)))) (cond ((sb-posix:s-isreg mode) :file) ((sb-posix:s-isdir mode) :directory) (t nil)))) (defmacro atomically (&body forms) `(acl-mp:without-scheduling ,@forms)) (defun unix-signal (signal pid) (declare (ignore signal pid)) (error "unix-signal not implemented in acl-excl-sbcl.lisp")) (defun filesys-inode (path) (sb-posix:stat-ino (sb-posix:lstat path))) (defun cl-internal-real-time () (round (/ (get-internal-real-time) internal-time-units-per-second))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/sbcl/acl-mp.lisp000066400000000000000000000253601133377100500250410ustar00rootroot00000000000000;; Threading for sbcl, or stub functions for single-threaded sbcl. ;; ;; Written by Rudi Schlatte, intended to be distributed along with the ;; acl-compat library, under the same license as the rest of it. ;; Inspirations taken from Dan Barlow's work for ;; McCLIM; cut, pasted and mutilated with permission. (in-package :acl-compat.mp) (defstruct (process (:constructor %make-process) (:predicate processp)) name state whostate function ; function wot will be run arguments ; arguments to the function id ; pid of unix thread or nil %lock ; lock for process structure mutators run-reasons ; primitive mailbox for IPC %queue ; queue for condition-wait initial-bindings ; special variable bindings property-list) (defparameter *current-process* #-sb-thread (%make-process) #+sb-thread ;; We don't fill in the process id, so the process compiling this ;; (the REPL, in most cases) can't be killed by accident. (loop for ;; p in (all-processes) do (kill-process p)), anyone? (%make-process :name "initial process" :function nil)) (defparameter *all-processes-lock* (sb-thread:make-mutex :name "all processes lock")) (defparameter *all-processes* (list *current-process*)) #-sb-thread (defun make-process (&key (name "Anonymous") reset-action run-reasons arrest-reasons (priority 0) quantum resume-hook suspend-hook initial-bindings run-immediately) (declare (ignore reset-action arrest-reasons priority quantum resume-hook suspend-hook run-immediately)) (%make-process :name "the only process" :run-reasons run-reasons :initial-bindings initial-bindings)) #+sb-thread (defun make-process (&key (name "Anonymous") reset-action run-reasons arrest-reasons (priority 0) quantum resume-hook suspend-hook initial-bindings run-immediately) (declare (ignore reset-action arrest-reasons priority quantum resume-hook suspend-hook run-immediately)) (let ((p (%make-process :name name :run-reasons run-reasons :initial-bindings initial-bindings :%lock (sb-thread:make-mutex :name (format nil "Internal lock for ~A" name)) :%queue (sb-thread:make-waitqueue :name (format nil "Blocking queue for ~A" name))))) (sb-thread:with-mutex (*all-processes-lock*) (push p *all-processes*)) p)) (defmacro defun/sb-thread (name args &body body) #-sb-thread (declare (ignore body)) `(defun ,name ,args #-sb-thread (declare (ignore ,@(remove-if (lambda (x) (member x '(&optional &rest &key &allow-other-keys &aux))) (mapcar (lambda (x) (if (consp x) (car x) x)) args)))) #-sb-thread (error "~A: Calling a multiprocessing function on a single-threaded sbcl build" ',name) #+sb-thread ,@body)) (defun/sb-thread process-interrupt (process function) (sb-thread:interrupt-thread (process-id process) function)) ;; TODO: why no such function was in +sb-thread part? (defun/sb-thread process-wait-function (process) (declare (ignore process))) (defun/sb-thread process-wait (reason predicate &rest arguments) (declare (type function predicate)) (let ((old-state (process-whostate *current-process*))) (unwind-protect (progn (setf old-state (process-whostate *current-process*) (process-whostate *current-process*) reason) (loop (let ((it (apply predicate arguments))) (when it (return it))) (process-allow-schedule))) (setf (process-whostate *current-process*) old-state)))) (defun/sb-thread process-allow-schedule (&optional process) (declare (ignore process)) (sleep .01)) (defun/sb-thread process-revoke-run-reason (process object) (sb-thread:with-recursive-lock ((process-%lock process)) (prog1 (setf (process-run-reasons process) (delete object (process-run-reasons process))) (when (and (process-id process) (not (process-run-reasons process))) (disable-process process))))) (defun/sb-thread process-add-run-reason (process object) (sb-thread:with-recursive-lock ((process-%lock process)) (prog1 (push object (process-run-reasons process)) (if (process-id process) (enable-process process) (restart-process process))))) (defun/sb-thread process-run-function (name-or-options preset-function &rest preset-arguments) (let* ((make-process-args (etypecase name-or-options (list name-or-options) (string (list :name name-or-options)))) (process (apply #'make-process make-process-args))) (apply #'process-preset process preset-function preset-arguments) (setf (process-run-reasons process) :enable) (restart-process process) process)) (defun/sb-thread process-preset (process function &rest arguments) (setf (process-function process) function (process-arguments process) arguments) (when (process-id process) (restart-process process))) (defun/sb-thread process-kill (process) (when (process-id process) (sb-thread:destroy-thread (process-id process)) (setf (process-id process) nil)) (sb-thread:with-mutex (*all-processes-lock*) (setf *all-processes* (delete process *all-processes*)))) #+sb-thread (defun make-process-lock (&key name) (sb-thread:make-mutex :name name)) #-sb-thread (defun make-process-lock (&key name) (declare (ignore name)) nil) (defun/sb-thread process-lock (lock &optional lock-value whostate timeout) (declare (ignore whostate timeout)) (sb-thread:get-mutex lock lock-value)) (defun/sb-thread process-unlock (lock &optional lock-value) (declare (ignore lock-value)) (sb-thread:release-mutex lock)) #-sb-thread (defmacro with-process-lock ((lock &key norecursive timeout whostate) &body forms) (declare (ignore lock norecursive timeout whostate)) `(progn ,@forms)) #+sb-thread (defmacro with-process-lock ((place &key timeout whostate norecursive) &body body) (declare (ignore norecursive timeout)) (let ((old-whostate (gensym "OLD-WHOSTATE"))) `(sb-thread:with-recursive-lock (,place) (let (,old-whostate) (unwind-protect (progn (when ,whostate (setf ,old-whostate (process-whostate *current-process*)) (setf (process-whostate *current-process*) ,whostate)) ,@body) (setf (process-whostate *current-process*) ,old-whostate)))))) #-sb-thread (defmacro without-scheduling (&body forms) `(progn ,@forms)) ; * ;;; FIXME but, of course, we can't. Fix whoever wants to use it, ;;; instead #+sb-thread (defmacro without-scheduling (&body body) `(progn ,@body)) ;;; Same implementation for multi- and uni-thread (defmacro with-timeout ((seconds &body timeout-forms) &body body) (let ((c (gensym "TIMEOUT-"))) `(handler-case (sb-ext::with-timeout ,seconds (progn ,@body)) (sb-ext::timeout (,c) (declare (ignore ,c)) ,@timeout-forms)))) (defun/sb-thread restart-process (process) (labels ((boing () (let ((*current-process* process) (bindings (process-initial-bindings process)) (function (process-function process)) (arguments (process-arguments process))) (declare (type function function)) (if bindings (progv (mapcar #'car bindings) (mapcar #'(lambda (binding) (eval (cdr binding))) bindings) (apply function arguments)) (apply function arguments))))) (when (process-id process) (sb-thread:terminate-thread (process-id process))) ;; XXX handle run-reasons in some way? Should a process continue ;; running if all run reasons are taken away before ;; restart-process is called? (process-revoke-run-reason handles ;; this, so let's say (setf (process-run-reasons process) nil) is ;; not guaranteed to do the Right Thing.) (when (setf (process-id process) (sb-thread:make-thread #'boing :name (process-name process))) process))) (defun current-process () *current-process*) (defun all-processes () (copy-list *all-processes*)) (defun/sb-thread process-wait-with-timeout (reason timeout predicate) (declare (type function predicate)) (let ((old-state (process-whostate *current-process*)) (end-time (+ (get-universal-time) timeout))) (unwind-protect (progn (setf old-state (process-whostate *current-process*) (process-whostate *current-process*) reason) (loop (let ((it (funcall predicate))) (when (or (> (get-universal-time) end-time) it) (return it))) (sleep .01))) (setf (process-whostate *current-process*) old-state)))) (defun/sb-thread disable-process (process) ;; TODO: set process-whostate ;; Can't figure out how to safely block a thread from a different one ;; and handle all the locking nastiness. So punt for now. (if (eq sb-thread:*current-thread* (process-id process)) ;; Keep waiting until we have a reason to run. GC and other ;; things can break a wait prematurely. Don't know if this is ;; expected or not. (do () ((process-run-reasons process) nil) (sb-thread:with-recursive-lock ((process-%lock process)) (sb-thread:condition-wait (process-%queue process) (process-%lock process)))) (error "Can't safely disable-process from another thread"))) (defun/sb-thread enable-process (process) ;; TODO: set process-whostate (sb-thread:with-recursive-lock ((process-%lock process)) (sb-thread:condition-notify (process-%queue process)))) ;;; TODO: integrate with McCLIM / system-wide queue for such things #+sb-thread (defvar *atomic-spinlock* (sb-thread::make-spinlock)) #-sb-thread (defmacro atomic-incf (place) `(incf ,place)) #+sb-thread (defmacro atomic-incf (place) `(sb-thread::with-spinlock (*atomic-spinlock*) (incf ,place))) #-sb-thread (defmacro atomic-decf (place) `(decf ,place)) #+sb-thread (defmacro atomic-decf (place) `(sb-thread::with-spinlock (*atomic-spinlock*) (decf ,place))) (defun process-active-p (process) (sb-thread:thread-alive-p (process-id process))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/sbcl/acl-socket.lisp000066400000000000000000000264721133377100500257220ustar00rootroot00000000000000;; This package is designed for sbcl. It implements the ;; ACL-style socket interface on top of sbcl. ;; ;; Written by Rudi Schlatte, based on the work done by Jochen Schmidt ;; for Lispworks and net.lisp in the port library of CLOCC. (in-package #:acl-compat.socket) (defclass server-socket () ((socket :initarg :socket :reader socket :initform (error "No value supplied for socket")) (element-type :type (member signed-byte unsigned-byte base-char) :initarg :element-type :reader element-type :initform (error "No value supplied for element-type")) (port :type fixnum :initarg :port :reader port :initform (error "No value supplied for port")) (stream-type :type (member :text :binary :bivalent) :initarg :stream-type :reader stream-type :initform (error "No value supplied for stream-type")))) (defclass datagram-socket (server-socket) ()) (defmethod print-object ((socket server-socket) stream) (print-unreadable-object (socket stream :type t :identity nil) (format stream "listening on port ~d" (port socket)))) (defmethod print-object ((socket datagram-socket) stream) (print-unreadable-object (socket stream :type t :identity nil) (format stream "datagram socket listening on port ~d" (port socket)))) (defgeneric accept-connection (socket &key wait)) (defmethod accept-connection ((server-socket server-socket) &key (wait t)) "Return a bidirectional stream connected to socket." (if (sb-sys:wait-until-fd-usable (socket-file-descriptor (socket server-socket)) :input (if (numberp wait) wait nil)) (let* ((socket (socket-accept (socket server-socket))) (stream (socket-make-stream socket :input t :output t ;; :buffering :none :element-type (element-type server-socket)))) (if (eq (stream-type server-socket) :bivalent) ;; HACK: remember socket, so we can do peer lookup (make-bivalent-stream stream :plist `(:socket ,socket)) stream)) nil)) (defmethod receive-from ((socket datagram-socket) size &key buffer extract) (multiple-value-bind (rbuf len address port) (socket-receive (socket socket) buffer size) (declare (ignore port)) (let ((buf (if (not extract) rbuf (subseq rbuf 0 len)))) ;; FIXME: am I right? (when buffer (replace buffer buf :end2 len)) (values (if buffer buffer buf) len address)))) (defmethod send-to ((socket datagram-socket) buffer size &key remote-host remote-port) (let* ((rhost (typecase remote-host (string (lookup-hostname remote-host)) (otherwise remote-host))) (s (socket socket)) (stream (progn (socket-connect s rhost remote-port) (socket-make-stream s :input t :output t :buffering :none)))) (write-sequence buffer stream) size)) (defun make-socket (&key (type :stream) (remote-host "localhost") local-port remote-port (connect :active) (format :text) (reuse-address t) &allow-other-keys) "Return a stream connected to remote-host if connect is :active, or something listening on local-port that can be fed to accept-connection if connect is :passive. This is an incomplete implementation of ACL's make-socket function! It was written to provide the functionality necessary to port AllegroServe. Refer to http://franz.com/support/documentation/6.1/doc/pages/operators/socket/make-socket.htm to read about the missing parts." (check-type remote-host string) (let ((element-type (ecase format (:text 'base-char) (:binary 'signed-byte) (:bivalent 'unsigned-byte))) (socket (if (eq type :datagram) (progn (setf connect :passive-udp) (make-instance 'inet-socket :type :datagram :protocol :udp)) (make-instance 'inet-socket :type :stream :protocol :tcp)))) (ecase connect (:passive-udp (setf (sockopt-reuse-address socket) reuse-address) (if local-port (socket-bind socket #(0 0 0 0) local-port)) (make-instance 'datagram-socket :port (nth-value 1 (socket-name socket)) :socket socket :element-type element-type :stream-type format)) (:passive (setf (sockopt-reuse-address socket) reuse-address) (if local-port (socket-bind socket #(0 0 0 0) local-port)) (socket-listen socket 10) ;Arbitrarily chosen backlog value (make-instance 'server-socket :port (nth-value 1 (socket-name socket)) :socket socket :element-type element-type :stream-type format)) (:active (socket-connect socket (lookup-hostname remote-host) remote-port) (let ((stream (socket-make-stream socket :input t :output t :element-type element-type ;; No buffering temporarily ;; for SBCL due to fd-stream ;; problems, see ;; portableaserve-help Mail ;; "Various fixes" (Hannu ;; Koivisto, 2007-02-25) #+sbcl :buffering #+sbcl :none ))) (if (eq :bivalent format) ;; HACK: remember socket, so we can do peer lookup (make-bivalent-stream stream :plist `(:socket ,socket)) stream)))))) (defmethod close ((server server-socket) &key abort) "Kill a passive (listening) socket. (Active sockets are actually streams and handled by their close methods." (declare (ignore abort)) (socket-close (socket server))) #+ignore (declaim (ftype (function ((unsigned-byte 32) &key (:values t)) (or (values fixnum fixnum fixnum fixnum) (values simple-string))) ipaddr-to-dotted)) (defun ipaddr-to-dotted (ipaddr &key values) "Convert from 32-bit integer to dotted string." (declare (type (unsigned-byte 32) ipaddr)) (let ((a (logand #xff (ash ipaddr -24))) (b (logand #xff (ash ipaddr -16))) (c (logand #xff (ash ipaddr -8))) (d (logand #xff ipaddr))) (if values (values a b c d) (format nil "~d.~d.~d.~d" a b c d)))) (defun ipaddr-to-vector (ipaddr) "Convert from 32-bit integer to a vector of octets." (declare (type (unsigned-byte 32) ipaddr)) (let ((a (logand #xff (ash ipaddr -24))) (b (logand #xff (ash ipaddr -16))) (c (logand #xff (ash ipaddr -8))) (d (logand #xff ipaddr))) (make-array 4 :initial-contents (list a b c d)))) (declaim (ftype (function (vector) (values (unsigned-byte 32))) vector-to-ipaddr)) (defun vector-to-ipaddr (sensible-ipaddr) "Convert from 4-integer vector to 32-bit integer." (loop with result = 0 for component across sensible-ipaddr do (setf result (+ (ash result 8) component)) finally (return result))) (defun string-tokens (string) (labels ((get-token (str pos1 acc) (let ((pos2 (position #\Space str :start pos1))) (if (not pos2) (nreverse acc) (get-token str (1+ pos2) (cons (read-from-string (subseq str pos1 pos2)) acc)))))) (get-token (concatenate 'string string " ") 0 nil))) (declaim (ftype (function (string &key (:errorp t)) (or null (unsigned-byte 32))) dotted-to-ipaddr)) (defun dotted-to-ipaddr (dotted &key (errorp t)) "Convert from dotted string to 32-bit integer." (declare (string dotted)) (if errorp (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll))) (ignore-errors (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll)))))) (defun ipaddr-to-hostname (ipaddr &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword in IPADDR-TO-HOSTNAME not supported.")) (host-ent-name (get-host-by-address (ipaddr-to-vector ipaddr)))) (defun lookup-hostname (host &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword in LOOKUP-HOSTNAME not supported.")) (if (stringp host) (host-ent-address (get-host-by-name host)) (dotted-to-ipaddr (ipaddr-to-dotted host)))) (defun remote-host (socket-stream) (let (socket) (if (and (typep socket-stream 'chunked-stream) (setf socket (getf (stream-plist socket-stream) :socket))) (vector-to-ipaddr (socket-peername socket)) (progn (warn "Could not get remote host for ~S" socket-stream) 0)))) (defun remote-port (socket-stream) (let (socket) (if (and (typep socket-stream 'chunked-stream) (setq socket (getf (stream-plist socket-stream) :socket))) (nth-value 1 (socket-peername socket)) (progn (warn "Could not get remote port for ~S" socket-stream) 0)))) (defun local-host (thing) (typecase thing (chunked-stream (let ((socket (getf (stream-plist thing) :socket))) (if socket (vector-to-ipaddr (socket-name socket)) (progn (warn "Socket not in plist of ~S -- could not get local host" thing) 0)))) (server-socket (vector-to-ipaddr #(127 0 0 1))) (t (progn (warn "Could not get local host for ~S" thing) 0)))) (defun local-port (thing) (typecase thing (chunked-stream (let ((socket (getf (stream-plist thing) :socket))) (if socket (nth-value 1 (socket-name socket)) (progn (warn "Socket not in plist of ~S -- could not get local port" thing) 0)))) (server-socket (port thing)) (t (progn (warn "Could not get local port for ~S" thing) 0)))) ;; Now, throw chunking in the mix (defclass chunked-stream (de.dataheaven.chunked-stream-mixin::chunked-stream-mixin gray-stream::buffered-bivalent-stream) ((plist :initarg :plist :accessor stream-plist))) (defun make-bivalent-stream (lisp-stream &key plist) (make-instance 'chunked-stream :lisp-stream lisp-stream :plist plist)) (defun socket-control (stream &key (output-chunking nil oc-p) output-chunking-eof (input-chunking nil ic-p)) (when oc-p (when output-chunking (de.dataheaven.chunked-stream-mixin::initialize-output-chunking stream)) (setf (de.dataheaven.chunked-stream-mixin::output-chunking-p stream) output-chunking)) (when output-chunking-eof (de.dataheaven.chunked-stream-mixin::disable-output-chunking stream)) (when ic-p (when input-chunking (de.dataheaven.chunked-stream-mixin::initialize-input-chunking stream)) (setf (de.dataheaven.chunked-stream-mixin::input-chunking-p stream) input-chunking))) (provide 'acl-socket) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/sbcl/acl-sys.lisp000066400000000000000000000003501133377100500252330ustar00rootroot00000000000000(in-package :acl-compat.system) (defun command-line-arguments () sb-ext:*posix-argv*) (defun command-line-argument (n) (nth n sb-ext:*posix-argv*)) (defun reap-os-subprocess (&key (wait nil)) (declare (ignore wait)) nil) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/scl/000077500000000000000000000000001133377100500226275ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/scl/acl-excl.lisp000066400000000000000000000220321133377100500252070ustar00rootroot00000000000000;;;; ;;;; ACL-COMPAT - EXCL ;;;; ;;;; Implementation-specific parts of acl-compat.excl (see ;;;; acl-excl-common.lisp) (defpackage :acl-compat.excl (:use #:common-lisp #:ext) (:export #:if* #:*initial-terminal-io* #:*cl-default-special-bindings* #:filesys-size #:filesys-write-date #:stream-input-fn #:match-regexp #:compile-regexp #:*current-case-mode* #:intern* #:filesys-type #:errorset #:atomically #:fast #:without-package-locks #:string-to-octets #:write-vector ;; TODO: find better place for bivalent stream classes #:bivalent-input-stream #:bivalent-output-stream #:bivalent-stream #:make-bivalent-input-stream #:make-bivalent-output-stream #:make-bivalent-stream )) (in-package :acl-compat.excl) (defun stream-input-fn (stream) stream) (defun filesys-type (file-or-directory-name) (if (eq :directory (unix:unix-file-kind (namestring file-or-directory-name))) :directory (if (probe-file file-or-directory-name) :file nil))) (defmacro atomically (&body forms) `(mp:without-scheduling ,@forms)) (defun unix-signal (signal pid) ;; fixxme: did I get the arglist right? only invocation I have seen ;; is (excl::unix-signal 15 0) in net.aserve:start (unix:unix-kill pid signal)) (defmacro without-package-locks (&body forms) `(progn ,@forms)) ;;; Bivalent Gray streams (defclass lisp-stream-mixin () ;; For bivalent streams, lisp-stream must be a stream of type ;; unsigned-byte ((lisp-stream :initarg :lisp-stream :accessor lisp-stream))) (defclass bivalent-input-stream (lisp-stream-mixin fundamental-character-input-stream fundamental-binary-input-stream)) (defclass bivalent-output-stream (lisp-stream-mixin fundamental-character-output-stream fundamental-binary-output-stream)) (defclass bivalent-stream (bivalent-input-stream bivalent-output-stream)) (defun make-bivalent-input-stream (lisp-stream) (declare (type system:lisp-stream lisp-stream)) (make-instance 'bivalent-input-stream :lisp-stream lisp-stream)) (defun make-bivalent-output-stream (lisp-stream) (declare (type system:lisp-stream lisp-stream)) (make-instance 'bivalent-output-stream :lisp-stream lisp-stream)) (defun make-bivalent-stream (lisp-stream) (declare (type system:lisp-stream lisp-stream)) (make-instance 'bivalent-stream :lisp-stream lisp-stream)) (defmethod open-stream-p ((stream lisp-stream-mixin)) (common-lisp::open-stream-p (lisp-stream stream))) (defmethod close ((stream lisp-stream-mixin) &key abort) (close (lisp-stream stream) :abort abort)) (defmethod input-stream-p ((stream lisp-stream-mixin)) (input-stream-p (lisp-stream stream))) (defmethod output-stream-p ((stream lisp-stream-mixin)) (output-stream-p (lisp-stream stream))) (defmethod stream-element-type ((stream bivalent-input-stream)) '(or character (unsigned-byte 8))) (defmethod stream-read-char ((stream bivalent-input-stream)) (code-char (read-byte (lisp-stream stream) nil :eof))) (defmethod stream-read-byte ((stream bivalent-input-stream)) (read-byte (lisp-stream stream) nil :eof)) ;; stream-unread-char (defmethod stream-read-char-no-hang ((stream bivalent-input-stream)) (if (listen (lisp-stream stream)) (code-char (read-byte (lisp-stream stream))) nil)) ;; stream-peek-char (defmethod stream-listen ((stream bivalent-input-stream)) (listen (lisp-stream stream))) (defmethod stream-clear-input ((stream bivalent-input-stream)) (clear-input (lisp-stream stream))) (defmethod stream-read-sequence ((stream bivalent-input-stream) (seq vector) &optional start end) (unless start (setf start 0)) (unless end (setf end (length seq))) (assert (<= end (length seq))) (if (subtypep (array-element-type seq) 'character) (loop for count upfrom start for i from start below end do (setf (aref seq i) (code-char (read-byte stream))) finally (return count)) (read-sequence seq (lisp-stream stream) :start start :end end))) (defmethod stream-read-sequence ((stream bivalent-input-stream) (seq cons) &optional (start 0) end) (unless start (setf start 0)) (unless end (setf end (length seq))) (let ((seq (nthcdr start seq))) (loop for count upfrom start for head on seq for i below (- end start) while head do (setf (car head) (read-byte stream)) finally (return count)))) (defmethod stream-read-sequence ((stream bivalent-input-stream) (seq null) &optional (start 0) end) (declare (ignore end)) start) (defmethod stream-element-type ((stream bivalent-output-stream)) '(or character (unsigned-byte 8))) (defmethod stream-write-char ((stream bivalent-output-stream) character) (write-byte (char-code character) (lisp-stream stream))) (defmethod stream-write-byte ((stream bivalent-output-stream) byte) (write-byte byte (lisp-stream stream))) (defmethod stream-line-column ((stream bivalent-output-stream)) nil) (defmethod stream-finish-output ((stream bivalent-output-stream)) (finish-output (lisp-stream stream))) (defmethod stream-force-output ((stream bivalent-output-stream)) (force-output (lisp-stream stream))) (defmethod stream-clear-output ((stream bivalent-output-stream)) (clear-output (lisp-stream stream))) (defmethod stream-write-sequence ((stream bivalent-output-stream) (seq vector) &optional (start 0) end) (let ((length (length seq))) (unless end (setf end length)) (assert (<= end length))) (unless start (setf start 0)) (when (< end start) (cerror "Continue with switched start and end ~s <-> ~s" "Stream-write-sequence: start (~S) and end (~S) exchanged." start end seq) (rotatef start end)) (cond ((subtypep (array-element-type seq) '(unsigned-byte 8)) (write-sequence seq (lisp-stream stream) :start start :end end)) ((subtypep (array-element-type seq) 'character) (loop for i from start below end do (stream-write-char stream (aref seq i)))) ((subtypep (array-element-type seq) 'integer) (loop for i from start below end do (stream-write-byte stream (aref seq i))))) seq) (defmethod stream-write-sequence ((stream bivalent-output-stream) (seq cons) &optional (start 0) end) (let ((length (length seq))) (unless end (setf end length)) (assert (<= end length))) (unless start (setf start 0)) (when (< end start) (cerror "Continue with switched start and end ~s <-> ~s" "Stream-write-sequence: start (~S) and end (~S) exchanged." start end seq) (rotatef start end)) (let ((seq (nthcdr start seq))) (loop for element in seq for i below (- end start) while seq do (etypecase element (character (stream-write-char stream element)) (integer (stream-write-byte stream element))))) seq) (defmethod stream-write-sequence ((stream bivalent-output-stream) (seq null) &optional (start 0) end) (declare (ignore start end)) seq) ;;; End bivalent Gray streams (defun string-to-octets (string &key (null-terminate t) (start 0) end mb-vector make-mb-vector? (external-format :default)) "This function returns a lisp-usb8-vector and the number of bytes copied." (declare (ignore external-format)) ;; The end parameter is different in ACL's lambda list, but this ;; variant lets us give an argument :end nil explicitly, and the ;; right thing will happen (unless end (setf end (length string))) (let* ((number-of-octets (if null-terminate (1+ (- end start)) (- end start))) (mb-vector (cond ((and mb-vector (>= (length mb-vector) number-of-octets)) mb-vector) ((or (not mb-vector) make-mb-vector?) (make-array (list number-of-octets) :element-type '(unsigned-byte 8) :initial-element 0)) (t (error "Was given a vector of length ~A, ~ but needed at least length ~A." (length mb-vector) number-of-octets))))) (declare (type (simple-array (unsigned-byte 8) (*)) mb-vector)) (loop for from-index from start below end for to-index upfrom 0 do (progn (setf (aref mb-vector to-index) (char-code (aref string from-index))))) (when null-terminate (setf (aref mb-vector (1- number-of-octets)) 0)) (values mb-vector number-of-octets))) (provide 'acl-excl) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/scl/acl-mp.lisp000066400000000000000000000123651133377100500247000ustar00rootroot00000000000000;; This package is designed for cmucl. It implements ACL-style ;; multiprocessing on top of cmucl (basically, process run reasons and ;; some function renames). ;; ;; Written by Rudi Schlatte, based on the work done by Jochen Schmidt ;; for Lispworks. (in-package :acl-compat-mp) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Import equivalent parts from the CMU MP package ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (shadowing-import '(mp:*current-process* ;; mp::process-preset mp::process-reset mp:process-interrupt mp::process-name mp::process-wait-function mp:process-run-reasons mp:process-add-run-reason mp:process-revoke-run-reason mp:process-arrest-reasons mp:process-add-arrest-reason mp:process-revoke-arrest-reason mp:process-whostate ; mp:without-interrupts mp:process-wait mp:with-timeout mp:without-scheduling )) (export '(*current-process* ;; process-preset process-reset process-interrupt process-name process-wait-function process-whostate process-wait with-timeout without-scheduling process-run-reasons process-add-run-reason process-revoke-run-reason process-arrest-reasons process-add-arrest-reason process-revoke-arrest-reason )) (defun process-allow-schedule () (mp:process-yield)) (defvar *process-plists* (make-hash-table :test #'eq) "maps processes to their plists. See the functions process-plist, (setf process-plist).") (defun process-property-list (process) (gethash process *process-plists*)) (defun (setf process-property-list) (new-value process) (setf (gethash process *process-plists*) new-value)) #|| ;;; rudi 2002-06-09: This is not needed as of cmucl 18d, thanks to Tim ;;; Moore who added run reasons to cmucl's multithreading. Left in ;;; for the time being just in case someone wants to get acl-compat ;;; running on older cmucl's. Can be deleted safely. (defvar *process-run-reasons* (make-hash-table :test #'eq) "maps processes to their run-reasons. See the functions process-run-reasons, (setf process-run-reasons), process-add-run-reason, process-revoke-run-reason.") (defun process-run-reasons (process) (gethash process *process-run-reasons*)) (defun (setf process-run-reasons) (new-value process) (mp:without-scheduling (prog1 (setf (gethash process *process-run-reasons*) new-value) (if new-value (mp:enable-process process) (mp:disable-process process))))) (defun process-revoke-run-reason (process object) (without-scheduling (setf (process-run-reasons process) (remove object (process-run-reasons process)))) (when (and (eq process mp:*current-process*)) (mp:process-yield))) (defun process-add-run-reason (process object) (setf (process-run-reasons process) (pushnew object (process-run-reasons process)))) ||# (defun process-run-function (name-or-options preset-function &rest preset-arguments) (let ((process (ctypecase name-or-options (string (make-process :name name-or-options)) (list (apply #'make-process name-or-options))))) (apply #'acl-mp::process-preset process preset-function preset-arguments) process)) (defun process-preset (process preset-function &rest arguments) (mp:process-preset process #'(lambda () (apply-with-bindings preset-function arguments (process-initial-bindings process))))) (defvar *process-initial-bindings* (make-hash-table :test #'eq)) (defun process-initial-bindings (process) (gethash process *process-initial-bindings*)) (defun (setf process-initial-bindings) (bindings process) (setf (gethash process *process-initial-bindings*) bindings)) ;;; ;;; ;;; Contributed by Tim Moore ;;; ;;; ;;; (defun apply-with-bindings (function args bindings) (if bindings (progv (mapcar #'car bindings) (mapcar #'(lambda (binding) (eval (cdr binding)))) (apply function args)) (apply function args))) (defun make-process (&key (name "Anonymous") reset-action run-reasons arrest-reasons (priority 0) quantum resume-hook suspend-hook initial-bindings run-immediately) (declare (ignore priority quantum reset-action resume-hook suspend-hook run-immediately)) (mp:make-process nil :name name :run-reasons run-reasons :arrest-reasons arrest-reasons :initial-bindings initial-bindings)) (defun process-kill (process) (mp:destroy-process process)) (defun make-process-lock (&key name) (mp:make-lock name)) (defmacro with-process-lock ((lock &key norecursive) &body forms) (declare (ignore norecursive)) `(mp:with-lock-held (,lock) ,@forms)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/scl/acl-socket.lisp000066400000000000000000000164401133377100500255520ustar00rootroot00000000000000;; This package is designed for scl. It implements the ;; ACL-style socket interface on top of scl. ;; ;; Written by Rudi Schlatte, based on the work done by Jochen Schmidt ;; for Lispworks and net.lisp in the port library of CLOCC. ;; ;; This was modified for SCL by Kevin Rosenberg (defpackage acl-socket (:use "MP" "COMMON-LISP") #+cl-ssl (:import-from :ssl "MAKE-SSL-CLIENT-STREAM" "MAKE-SSL-SERVER-STREAM") (:export #:socket #:make-socket #:accept-connection #:ipaddr-to-dotted #:dotted-to-ipaddr #:ipaddr-to-hostname #:lookup-hostname #:remote-host #:remote-port #:local-host #:local-port #:socket-control #+cl-ssl #:make-ssl-client-stream #+cl-ssl #:make-ssl-server-stream) (:nicknames socket)) (in-package socket) (defclass socket () ((fd :type fixnum :initarg :fd :reader fd))) (defmethod print-object ((socket socket) stream) (print-unreadable-object (socket stream :type t :identity t) (format stream "@~d" (fd socket)))) (defclass server-socket (socket) ((element-type :type (member signed-byte unsigned-byte base-char) :initarg :element-type :reader element-type :initform (error "No value supplied for element-type")) (port :type fixnum :initarg :port :reader port :initform (error "No value supplied for port")) (stream-type :type (member :text :binary :bivalent) :initarg :stream-type :reader stream-type :initform (error "No value supplied for stream-type")))) #+cl-ssl (defmethod make-ssl-server-stream ((lisp-stream system:lisp-stream) &rest options) (apply #'make-ssl-server-stream (system:fd-stream-fd lisp-stream) options)) (defmethod print-object ((socket server-socket) stream) (print-unreadable-object (socket stream :type t :identity nil) (format stream "@~d on port ~d" (fd socket) (port socket)))) (defmethod accept-connection ((server-socket server-socket) &key (wait t)) "Return a bidirectional stream connected to socket, or nil if no client wanted to initiate a connection and wait is nil." ;; fixxme: perhaps check whether we run multiprocessing and use ;; sys:wait-until-fd-usable instead of ;; mp:process-wait-until-fd-usable here? ;; api pipe fitting: wait t ==> timeout nil (when (mp:process-wait-until-fd-usable (fd server-socket) :input (if wait nil 0)) (let ((stream (sys:make-fd-stream (ext:accept-tcp-connection (fd server-socket)) :input t :output t :element-type (element-type server-socket) :auto-close t))) (if (eq (stream-type server-socket) :bivalent) (excl:make-bivalent-stream stream) stream)))) (defun make-socket (&key (remote-host "localhost") local-port remote-port (connect :active) (format :text) &allow-other-keys) "Return a stream connected to remote-host if connect is :active, or something listening on local-port that can be fed to accept-connection if connect is :passive. This is an incomplete implementation of ACL's make-socket function! It was written to provide the functionality necessary to port AllegroServe. Refer to http://franz.com/support/documentation/6.1/doc/pages/operators/socket/make-socket.htm to read about the missing parts." (check-type remote-host string) (let ((element-type (ecase format (:text 'base-char) (:binary 'signed-byte) (:bivalent 'unsigned-byte)))) (ecase connect (:passive (make-instance 'server-socket :port local-port :fd (ext:create-inet-listener local-port) :element-type element-type :stream-type format)) (:active (let ((stream (sys:make-fd-stream (ext:connect-to-inet-socket remote-host remote-port) :input t :output t :element-type element-type))) (if (eq :bivalent format) (excl:make-bivalent-stream stream) stream)))))) (defmethod close ((server server-socket) &key abort) "Kill a passive (listening) socket. (Active sockets are actually streams and handled by their close methods." (declare (ignore abort)) (unix:unix-close (fd server))) (declaim (ftype (function ((unsigned-byte 32) &key (:values t)) (values simple-string)) ipaddr-to-dotted)) (defun ipaddr-to-dotted (ipaddr &key values) (declare (type (unsigned-byte 32) ipaddr)) (let ((a (logand #xff (ash ipaddr -24))) (b (logand #xff (ash ipaddr -16))) (c (logand #xff (ash ipaddr -8))) (d (logand #xff ipaddr))) (if values (values a b c d) (format nil "~d.~d.~d.~d" a b c d)))) (defun string-tokens (string) (labels ((get-token (str pos1 acc) (let ((pos2 (position #\Space str :start pos1))) (if (not pos2) (nreverse acc) (get-token str (1+ pos2) (cons (read-from-string (subseq str pos1 pos2)) acc)))))) (get-token (concatenate 'string string " ") 0 nil))) (declaim (ftype (function (string &key (:errorp t)) (values (unsigned-byte 32))) dotted-to-ipaddr)) (defun dotted-to-ipaddr (dotted &key (errorp t)) (declare (string dotted)) (if errorp (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll))) (ignore-errors (let ((ll (string-tokens (substitute #\Space #\. dotted)))) (+ (ash (first ll) 24) (ash (second ll) 16) (ash (third ll) 8) (fourth ll)))))) (defun ipaddr-to-hostname (ipaddr &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword in IPADDR-TO-HOSTNAME not supported.")) (ext:host-entry-name (ext:lookup-host-entry ipaddr))) (defun lookup-hostname (host &key ignore-cache) (when ignore-cache (warn ":IGNORE-CACHE keyword in LOOKUP-HOSTNAME not supported.")) (if (stringp host) (car (ext:host-entry-addr-list (ext:lookup-host-entry host))) (dotted-to-ipaddr (ipaddr-to-dotted host)))) (defgeneric get-fd (stream)) (defmethod get-fd ((stream excl::lisp-stream-mixin)) (system:fd-stream-fd (excl::lisp-stream stream))) (defmethod get-fd ((stream system:lisp-stream)) (system:fd-stream-fd stream)) (defun remote-host (socket-stream) (ext:get-peer-host-and-port (get-fd socket-stream))) (defun remote-port (socket-stream) (multiple-value-bind (host port) (ext:get-peer-host-and-port (get-fd socket-stream)) (declare (ignore host)) port)) (defun local-host (socket-stream) (ext:get-socket-host-and-port (get-fd socket-stream))) (defun local-port (socket-stream) (if (typep socket-stream 'socket::server-socket) (port socket-stream) (multiple-value-bind (host port) (ext:get-socket-host-and-port (get-fd socket-stream)) (declare (ignore host)) port))) (defun socket-control (stream &key output-chunking output-chunking-eof input-chunking) (declare (ignore stream)) (warn "SOCKET-CONTROL function not implemented.") (when (or output-chunking output-chunking-eof input-chunking) (error "Chunking is not yet supported in scl. Restart the server with chunking off."))) (provide 'acl-socket) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/scl/acl-sys.lisp000066400000000000000000000005311133377100500250720ustar00rootroot00000000000000(in-package :sys) (ignore-errors (export 'command-line-arguments) (export 'command-line-argument) (export 'reap-os-subprocess) (defun command-line-arguments () ext:*command-line-strings*) (defun command-line-argument (n) (nth n ext:*command-line-strings*)) (defun reap-os-subprocess (&key (wait nil)) (declare (ignore wait)) nil) ) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/acl-compat/test-acl-socket.lisp000066400000000000000000000031461133377100500257450ustar00rootroot00000000000000;;; Unit tests for the ACL-SOCKET compatibility package. (in-package cl-user) (require :acl-socket) (use-package '(acl-socket)) (defun test1 () (let ((stream (make-socket :connect :active :remote-host "127.0.0.1" :remote-port 2500))) (when stream (read-line stream) (format stream "helo foo") (write-char #\Return stream) (write-char #\Linefeed stream) (finish-output stream) (read-line stream) (close stream)))) (defun test2 () (let ((stream (make-socket :connect :active :remote-host "127.0.0.1" :remote-port 2500))) (when stream (socket-control stream :output-chunking t) (read-line stream) (format stream "helo foo") (write-char #\Return stream) (write-char #\Linefeed stream) (finish-output stream) (read-line stream) (close stream)))) (defun test3 () (let ((stream (make-socket :connect :active :remote-host "127.0.0.1" :remote-port 2500))) (when stream (socket-control stream :input-chunking t) (prog1 (read-line stream) (close stream))))) (defun test4 () (let ((stream (or (make-socket :connect :active :remote-host "127.0.0.1" :remote-port 2500) (error "Failed to connect.")))) (socket-control stream :input-chunking t) (format t "File number 1: ") #1=(handler-case (loop for char = (read-char stream nil stream) until (eq char stream) do (write-char char)) (excl::socket-chunking-end-of-file (e) (socket-control stream :input-chunking t))) (format t "~%File number 2: ") #1# (terpri) (values))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/000077500000000000000000000000001133377100500213135ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/ChangeLog000066400000000000000000001070451133377100500230740ustar00rootroot000000000000002005-08-05 Gabor Melis * main.cl (connection-reset-error): detect sigpipe and "connection reset by peer" on sbcl * publish.cl: In http 1.1 keep alive is the default. Client needs to send "Connection: close". In http 1.0 non-persistent connection is the default, client needs to send "Connection: keep-alive". * main.cl: fixed atomic-{incf,decf} for sbcl 2004-01-09 John Foderaro 1.2.35 * publish.cl, main.cl, test/t-aserve.cl: add a slot to all entities holding the extra headers to add to the response. Add a :headers argument to all publish functions that allows one to store a value in the new headers slot. 2003-12-23 John Foderaro 1.2.34 * fix typo in exports wserver-io-timeout 2003-12-12 Kevin Layer * makefile: set base version to 6.2 * proxy.cl: fix typo in proxy-failure-response, include requested uri, too 2003-10-31 John Foderaro * cgi.cl - transfer data from script back to http client immediately rather than buffering it up. 2003-10-27 John Foderaro 1.2.33 * webactions/ files - change headers to include lgpl copyright info 2003-10-22 John Foderaro 1.2.32 * add webactions subdirectory of code 2003-09-22 John Foderaro 1.2.31 * authorize.cl: send back some text with failed response * publish.cl: fix html sent back to with failed responses 2003-09-22 * decode.cl: fix multiline base64 decoding. 2003-09-12 1.2.30 * load.cl: fix problem building on acl 7.0 on windows 2003-09-10 Kevin Layer 1.2.29 * load.cl, * examples/examples.cl, * examples/urian.cl: use *load-pathname* instead of *load-truename* since truename in ACL 7.0 goes through symbolic links and this doesn't work in the way aserve is built at franz (via symlinks to source code) 2003-09-04 John Foderaro 1.2.28 * non-standard http headers are again supported in all functions, including proxying (where they are just passed on or passed back as the case may be). 2003-08-12 John Foderaro * move the require of :uri to before the first reference to it in packages.cl 2003-05-09 1.2.27 * added a hook argument to most publish functions. documented as 'entity hook function' * chat.cl - use cookies to get around security problem * add compute-request-headers (an internal fucntion at the moment, I may export it in the future) 2003-05-08 John Foderaro * doc/aserve.html - clarify that you can have a list of authorization objects in an entity. * main.cl - make the uri-scheme of (request-uri req) correctly reflect if this is an https or http request. 2003-02-26 John Foderaro 1.2.26 * doc/aserve.html - new get-request-body argument 2003-02-24 Charles A. Cox New file: examples/locale.cl. * load.cl: add locale example. * main.cl: add external-format argument to get-request-body for spr27296. * examples/examples.cl: Minor home page cleanup for ics examples. * examples/urian.cl: Add extra smarts for determining a page's charset. * test/t-aserve.cl: Add spr27296 test. 2003-02-06 John Foderaro * main.cl - added (setf request-query-value) 2003-01-10 John Foderaro 1.2.25 * publish.cl (get-cookie-values): handle case of a cookie parameter not having value, i.e name2; Pretend it was name2=; 2003-01-07 John Foderaro * client.cl - when sending character data obey external formats * main.cl - initialize log stream to *initial-terminal-io* since *standard-output* could be bound to something during the loading process. * [htmlgen changes, see it's ChangeLog] 2002-09-06 John Foderaro * detect connection reset by peer on the AIX operating system * [change made in htmlgen ChangeLog] 2002-08-09 John Foderaro 1.2.24 * change #\newline to #\linefeed in the source for portability * fix :comment in htmlgen * put aserve package definitions and exports in new file: packages.cl 2002-04-10 John Foderaro * main.cl - fix bug in get-multipart-sequence when used in an International Lisp with multibyte character input. In certain rare cases it could get stuck decoding the last bits of a buffer. - add :ssl-password argument to net.aserve:start to specify the password for decrypting the private key in the file with the ssl certificate. [requires acl feature introduced in acl 6.2]2 * client.cl - if the content passed to do-http-request is a list of vectors, each vector in the list will be sent to the server. 2002-02-28 John Foderaro 1.2.23 >>> * incompatible change: The path part of a uri can't contain certain characters unless they are escaped like %xx. Even characters that needn't be escaped *can* be escaped. Thus to canonicalize the uri path and to allow it to be easily mapped to filenames we now decode the uri path (convert %xx to the actual character) before processing it (looking for matches in the published entities). If you had published a path like "foo%20bar" then you must change it to "foo bar". * cgi.cl - add default for :script-name arg * various - open socket in nodelay mode to maximize performance 2002-02-13 John Foderaro 1.2.22 * authorize.cl - add new authorizer: function-authorizer * cgi.cl - run-cgi-program takes a :env arguemnt to allow additional environment variables to be specified. 2002-01-15 John Foderaro 1.2.21 * main.cl - fix bug where the value of *default-aserve-external-format* was captured at macroexpansion time rather than run time. All code using with-http-body should be recompiled. * publish.cl - allow mime types to be specified for filenames that don't have a type component (e.g. ReadMe files). * publish.cl - set-cookie-header takes an encode-value argument to control whether it does encoding of its argument. 2002-01-07 John Foderaro * main.cl - fix problem of restarting aserve in non-ssl mode after starting it is ssl mode. 2002-01-06 John Foderaro * add :nofile return code to parse-multipart-header 2002-01-04 John Foderaro 1.2.20 * main.cl - add two higher level functions to aid retrieving multipart data: parse-multipart-header and get-all-multipart-data. The examples now show using both the low level and higher level functions for retrieving multipart form data. 2001-12-03 John Foderaro 1.2.19 * main.cl: add ensure-stream-lock function to put a lock object on a stream that the logging functions then can use. 2001-11-30 * doc/aserve.html - add documentation on using AllegroServe as an NT service, and a description of how to write web pages that handle international characters * main.cl - add :external-format argument to request-query-value 2001-11-28 John Foderaro * log.cl - use locking around writes to the log if the stream has a lock on it's property list. 2001-11-28 * add :binary type to publish-multi * chat.cl - add the ability to upload pictures 2001-11-26 John Foderaro 1.2.18 * decode.cl - handle character set decoding inside uri queries * publish.cl - access file caching 2001-11-15 John Foderaro 1.2.17 * added new publish fcn: publish-prefix >>> * incompatible changes: redid the way access files are processed, see the document for the latest spec. notable changes: :ignore is now :deny :block is gone from :subdirectories but I've added :allow and :deny for fine tuned blocking :inherit now defaults to nil you can have multiple forms of the same kind of information in a single access file and they will all be used. 2001-11-06 John Foderaro * fix bug causing infinite loop when reading truncated form body 2001-11-05 John Foderaro 1.2.16 * failed request now identifies AllegroServe as the server and gives its version number * if AllegroServe isn't setup to proxy it will not match proxy requests with local web pages. 2001-11-05 * log.cl - write to log files under the protection of a process lock found on the stream-property-list of the stream associated with the :lock indicator. If no such lock is found, write to the streame anyway. * examples/chat.cl - improve the speed of deleting messages by binary searching the existing messages. 2001-10-31 John Foderaro 1.2.15 * start now takes a host argument to allow you to bind the server to a specific host * publish-multi will not return 304 (not modified) unless the request is a get or a head * files published with publish-file will now obey a single range specifier so they will be download accelerator friendly 2001-10-26 John Foderaro * add entity-plist slot to entities and use it to link file entities to their parent directory entities with the :parent indicator * add map-entities function * print vhosts in a why that shows their host names 2001-10-24 John Foderaro 1.2.14 * added access files for publish-directory. These allow .htaccess-like controlling of what publish-directory publishes. >>> * incompatible change: added an extra argument to the publish-directory filter function and publisher functions. 2001-10-19 John Foderaro 1.2.13 * added publish-multi * while debugging (:notrap) we ignore connection reset by peer errors by default since they are frequent and not errors in most cases. You can have them recognized by setting *debug-connection-reset-by-peer* to t. 2001-10-18 John Foderaro * The initial log stream (which is used then to initialize vhost log streams) is now *initial-terminal-io* and not *standard-output*. * random messages (written by logmess) are now sent to the vhost-error-stream of the default-vhost of the server. This allows one to separate these random messages from the the request logs * logs of proxy activity is now sent to the vhost-error-stream of the default-vhost of the server. we may rethink this later. * support vhost specific request filters 2001-10-17 John Foderaro * cgi.cl: redo cgi so that it doesn't buffer data... also can now process standard error from scripts 2001-10-16 John Foderaro 1.2.12 >>> * incompatible change: the format argument to with-http-body has been moved to with-http-response. The format argument to with-http-body was ignored, but on with-http-response it will be obeyed and will override the format specified in the entity. The internal generic function compute-strategy now takes three arguments. This function isn't part of the external interface to AllegroServe but some users have specialized it. 2001-10-15 John Foderaro * add timeout value to each entity object to serve as a default that's checked before the wserver-response-timeout. * add a timeout argument to publish functions to set this entity timeout value. * add a publisher argument to publish-directory so users can control what kind of entity is created when the real file is eventually found. 2001-10-12 John Foderaro * using socket stream i/o timeouts in acl6.1 * moved the *http-response-timeout* to a slot in the wserver object so it can be server dependent. * documented timeouts in aserve.html * added timeout test to t-aserve.cl but disabled running them by default since they take a long time. 2001-10-10 John Foderaro 1.2.11 * upgraded support for virtual hosts, introducting an object to denote a virtual host so that each virtual host can do its own logging. See aserve.html for details on Virtual Hosts. 2001-10-08 John Foderaro * publish.cl - publish-directory must pass on host info to the publish-files that it does. - unpublish takes a :server argument 2001-09-29 John Foderaro * cgi.cl - fix bug where content-length was specified wrong 2001-09-21 John Foderaro 1.2.10 * added ability to run cgi programs new file cgi.cl 2001-09-20 John Foderaro * examples/examples.cl - add commentary to some of the links to make them clearer 2001-09-20 Kevin Layer * makefile: split `clean' into `clean' and `cleanall', the latter which removes aserve-src. * makefile (clean): add `r' to `rm' 2001-09-18 Kevin Layer 1.2.9 * makefile: add build and srcdist rules; have make clean remove aserve-src * load.cl: parameterize make-src-distributions's directory name 2001-09-12 John Foderaro 1.2.8 * client.cl: add :skip-body to do-http-request. add test for this. * decode.cl: fix form-urlencoded-to-query so that it can handle a non simple string (which can be returned under certain circumstances from get-request-body) 2001-08-28 John Foderaro 1.2.7 * take the default value for the external-format argument from *default-aserve-external-format*. net.aserve:start sets the value of *default-aserve-external-foramt* in worker threads. * parse.cl (split-string): don't get confused by commas inside a double quoted header parameter value. 2001-08-24 John Foderaro * when an error occurs in the worker thread print the command line for the request that got the error. 2001-08-16 John Foderaro 1.2.6 * main.cl - try harder to prevent debug output from multiple threads from getting jumbled up on the console * publish.cl - do a keep-alive connection if the data is a binary stream as long as we know the content length. Add a new internal entity type so that returns of "304 - Not Modified" can do keep alives too. 2001-08-15 John Foderaro 1.2.5 * main.cl - incf version number for new release 2001-08-09 John Foderaro * publish.cl - added :filter functionality to publish-directory * test/t-aserve.cl - test filters in publish-directory 2001-08-08 John Foderaro * publish.cl - allow list of index files to be specified in for each directory-entity. - specify a catch-all compute-response-stream method so users adding new entity type don't have to do so. 2001-08-08 jkf * publish.cl - fix for when no body is given with-http-body and thus a string-output-stream is not created. 2001-07-30 1.2.4 * main.cl: fix get-multipart-* to correspond to rfc2046 and thus it will work with the Opera browser which generates legal (but unusual) kinds of boundary markers 2001-07-19 John Foderaro 1.2.3 * publish.cl - If publish-file file is changed then invalidate the cached information on it. - remove extraneous slots in classes. * test/t-aserve.cl test cache invaldation in publish-file 2001-07-18 * doc/publish.html - update publish-file doc for preload and cache-p args * doc/htmlgen.html - make first example clearer * doc/tutorial.html - add note to help Windows users 2001-07-18 jkf * publish.cl - add cache-p argument to publish-file which will cache the file contents on first use * chat.cl - add support for removing selective private messages after a certain amount of time. * test/t-aserve.cl - test cache-p argument to publish-file 2001-07-09 John Foderaro * example/chat.cl - add chat transcript feature 2001-06-27 jkf 1.2.2 * added the ability to filter requests before they get processed. see Request-Filters in aserve.html 2001-06-26 John Foderaro 1.2.1 * main.cl - don't get blocked on a force-output that will never return due to the other side of the connection going away. * examples/chat.cl - support private chats amoung groups of people. Support deleting messages. Support levels of users. Support redirecting people at certain IP addresses away from the chat if they cause problems. 2001-06-05 John Foderaro 1.2.0 * main.cl - update version to 1.2.0 to mark acl 6.1 release. 2001-04-04 John Foderaro * changed how publish-directory deals with urls that point to directories and not files. It used to pretend that you specified an index.html or index.htm file in that directory. This was bad since relative urls in the index file would not be processed correctly. with the change it now redirects to the index.html or index.htm file so that the browser knows what it's getting. 2001-03-22 John Foderaro 1.1.41 * add os-processes argument to net.aserve:start which causes aserve to fork (on unix only) and create multiple operating system processes listening on the same port. 2001-02-08 John Foderaro 1.1.40 * added the proxy-proxy argument to net.aserve:start that permits you to specify that the allegroserve proxy should sent its requests through another proxy. 2001-02-06 John Foderaro 1.1.39 * proxy and scanning fixes 2001-01-22 John Foderaro 1.1.38 * main.cl: incf version. Also hooks added for links scanning. 2001-01-18 John Foderaro * examples/urian.cl - new international character set demo (reachable from the main aserve examples page) 2001-01-02 jkf 1.1.37 * main.cl, proxy.cl - add the ability to save and restore the whole state of the proxy cache. (see docs for start and shutdown in the manual). * ensure that proxy cache threads are killed off when a shutdown is done. >>> incompatible change: the net.aserve:shutdown function used to take an optional argument. Now it takes keyword arguments. 2000-12-27 John Foderaro 1.1.36 * client.cl: handle illegal set-cookie headers sent by Netscape's v3 web server. In a client request Split the single large Cookie line into muliple Cookie lines so that Netscape's v3 web server can understand them. Add a redirect-methods argument to do-http-request to support more user control of redirection. * proxy.cl - many enhancements including connection caching 2000-11-06 Kevin Layer 1.1.35 * log.cl: make logmess a method, so I can define an after method on it in my own code * main.cl: maybe-universal-time-to-date and universal-time-to-date: take time-zone optional argument, so my redefined version of log-request can specify the local time zone 2000-10-31 John Foderaro 1.1.34 * add to the list of characters to escape in form-urlencoding those that must be escaped so that the result can be put in the query string of a uri * in proxy code write request and headers in one big block to get around bug in IP redirectors (such as found in www.cbs.com) 2000-10-25 jkf 1.1.33 * hooks for link checking and experimenting with caching 2000-10-19 John Foderaro 1.1.32 * add ssl arguments to net.aserve.start and net.aserve.client:do-http-request so that a secure server can be started and secure http requests can be made. Make the aserve test suite test run though the tests using ssl. Note: the ssl module is only present in certain acl6 distributoins. * add examples/puzzle.cl - a demo featuring the use of international characters in acl6. 2000-10-15 John Foderaro 1.1.31 * support caching requests with cookies 2000-10-12 John Foderaro 1.1.30 * proxy and cache facilty added. 2000-09-22 Charles A. Cox * decode.cl: Add :external-format to to uriencode-string. * publish.cl: Add :external-format to set-cookie-header. * test/t-aserve.cl: Add :external-format tests for uri{en,de}code-string. 2000-09-07 Charles A. Cox 1.1.29 >>> Note: Many of the functions listed in this log entry have had the :external-format argument added. Documentation has been updated Note 2: All changes intended to be upward compatible. Allegro specific changes are marked with #+(and allegro (version>= 6 0)). * client.cl: make-http-client-request: add/use external-format argument. * decode.cl: uridecode-string, query-to-form-urlencoded, encode-form-urlencode, form-urlencoded-to-query: add/use external-format argument. * main.cl: with-http-body, request-query: add/use external-format argument. * publish.cl: get-cookie-values: add/use external-format argument. * examples/examples.cl: Add new international character examples. * test/t-aserve.cl: Add tests for external-format additions. 2000-08-28 John Foderaro 1.1.28 * client.cl - before doing a redirect close down the existing connection. 2000-08-25 John Foderaro * fix bug which caused file descriptors to remain open forever if a "connection reset by peer" error occured. Added the ability to track sockets opened by aserve to ensure that they were closed before being gc'ed away. 2000-08-24 John Foderaro 1.1.27 * rewrote the get-multipart-xxx functions to use an (unsigned-byte 8) buffer since character buffers have issues with international code. This eliminates the extra at the end problem with get-multipart-sequence. The file transfer should be faster, especially if you pass get-multipart-sequence a 4096 byte (unsigned-byte 8) vector. !! Eliminte the raw argument from get-multipart-sequence. Now transfers are all 'raw' If a character array is passed to get-multipart-sequence then we just copy into each character the code-char of the item in the buffer (which corresponds to the latin1-base external format). We will allow external-format select soon. 2000-08-21 John Foderaro * add :proxy arg to net.aserve:start so you can enable the proxy when you start the server. * fix test suite to report only legit errors 2000-08-20 jkf 1.1.26 * Added a proxy capability. enable-proxy will turn it on. Currently it acts an http/1.0 client and server since that makes it easier to debug. However this does cause 12 test set errors to be reported since it expects to see http/1.1 responses. 2000-08-17 jkf * implement generalized cons-free header parsing and use it in both the client and server. * change the header info returned by do-http-request to also use keywords to describe headers !! non upward compatiable change !! 2000-08-15 John Foderaro * fix bug where certain headers were sent twice 2000-08-12 John Foderaro * name headers by keyword symbols rather than strings !! this change is not upward compatible !! 2000-08-10 John Foderaro 1.1.25 * decode.cl: request-query will now convert items in query strings without values into ("keyname" . "") in the resulting alist. * doc/aserve.html - update doc of request-query and request-query-value to reflect what happens with null valued query elements 2000-08-09 jkf * publish.cl: write the transfer encoding as all lowercase 'chunked' since a bug in Mozilla M17 means it will only understand this form. * htmlgen/htmlgen.cl - add the tag 2000-08-04 jkf 1.1.24 * examples/chat.cl - add user logins and private messages between users. 2000-07-31 jkf * main.cl: if a multipart-mixed body was being sent then note that the request-body has been grabbed. 2000-07-25 jkf * example/chat.cl - enhanced to support logging into the chat 2000-07-17 John Foderaro 1.1.22 * main.cl: incf version 2000-07-15 John Foderaro * examples/chat.cl - sample program that does web based chat 2000-07-14 John Foderaro * client.cl - now do-http-request will always return a uri object (previously it would return its uri arg unless a redirect was done in which case it would return a uri object) 2000-07-01 John Foderaro * client.cl - handle the "100 continue" response we seem to get from IIS whenever we do a post. 2000-06-25 jkf * keep track all of all ip addresses by which the server is contacted (this is simpler than trying to figure them out in advance). * add function to find a response object given the code. * keep track of the raw uri by which a request was made (as distinguished from the uri in which we've added the host and port values). This is necessary to distriguish when we must proxy. * in html-print assume that attribute values are already html escaped 2000-06-12 John Foderaro * main.cl: add utility function request-query-value to combine getting the query info via request query and locating the particular value with assoc 2000-06-08 John Foderaro 1.1.21 * client.cl - do-http-request: 1. give the redirect arg a numeric value to prevent infinite redirect loops. 2. handle two other redirect codes 3. autoredirect only for get and head 4. return the uri accessed as the fourth value * main.cl - add more response codes - handle calls to request-query specifying different uri and post values. * examples.cl - add redirect test * t-aserve.cl - test redirection * doc/aserve.html - update for changes above * doc/tutorial.html - don't be so cookie centric 2000-05-30 John Foderaro 1.1.20 * macs.cl - add note about where to find the if* macro * main.cl - cache result of get-request-body so that it can safely be called more than once inside a response function. Also be sure to call get-request-body if the connection is keep-alive and there might be a body following the headers. * t-aserve.cl - test enhancment to get-request-body * doc/aserve.html - fix do-http-request documentation to reflect change made in 1.1.18 Fri May 26 22:42:12 PST 2000 Duane Rettig 1.1.19 * makefile: set SHELL variable * main.cl: incf version 2000-05-16 John Foderaro 1.1.18 * ! Non upward-compatiable change ! - the function do-http-request returns arguments in a different order, it now returns the body value first, then the response code and then the headers. * fixed bug in publish-directory (sourceforge bug 105426) * added query and content-type arguments to do-http-request and make-http-client-request. These make it even easier to send form data to web servers 2000-05-16 John Foderaro 1.1.17 * in order to make portions of the LGPL license meaningful for a Lisp program we've added a prequel to the license agreement in the file license-allegroserve.txt. 2000-05-16 jkf * client.cl - increase header reading buffer size - but we should make this growable. - handle cookies with = signs embedded * decode.cl - in query-to-form-urlencoded all the values to be non-strings and in that case use ~a format to stringify them * parse.cl - add arg to utility function 2000-05-04 John Foderaro 1.1.16 * request-query can now read from uri and/or post'ed body see doc/aserve.html for details 2000-04-26 John Foderaro 1.1.15 * ! Non upward-compatible change ! -- the function decode-form-urlencoded has been renamed form-urlencoded-to-query so as to match its new inverse function: query-to-form-urlencoded * added query-to-form-urlencoded to allow one to encode query to strings for use by client code. 2000-04-24 John Foderaro 1.1.14 * verify that it works in acl501 trial (Linux) 2000-04-24 * load.cl: make aServe load in acl5.0.1 Lite (Windows) but be advised that it doesn't work very well due to socket problems that can be patched in the Lite version. * main.cl: the default timeout for a with-http-response now comes from *http-response-timeout* and it now defaults to 120 seconds rather than 60. * some documention updates 2000-04-23 jkf * client.cl - added proxy argument so that client requests can go through a proxy * various doc fixes 2000-04-17 John Foderaro 1.1.13 * rename Allegro iServe to AllegroServe. As a result where iserve was used before we now use aserve. For example the package is now called net.aserve. 2000-04-17 John Foderaro 1.1.12 * add test/t-iserve.cl to the list of files in the ftp distribution 2000-04-16 * debug-on and debug-off are no longer exported symbols. They continue to exist but you have to use net.iserve::debug-on and net.iserve::debug-off to reach them. * added two new response type symbols to aid in doing redirections: *response-moved-permanently* *response-temporary-redirect* note that netscape 4 doesn't understand *response-temporary-redirect* as that's a http/1.1 thing. * request-query takes a :handle-post keyword arguments. When true (and that's the default) it will automatically read, extract, parse and cache the query string from the entity body when the request is a post request. 2000-03-28 John Foderaro * move htmlgen.html from htmlgen/ to doc/ so that it's in a consistent place regardless of distribution type. 2000-04-08 1.1.11 * make the debugging output feature based rather than numeric. see net.iserve:debug-on * properly do client queries * use setfable reply-header-slot-value to read and set headers for the reply that will be sent * always send back HTTP/1.1 as our protocol 2000-03-27 John Foderaro 1.1.10 * add headers argument to do-http-request and make-http-client-request to allow you to add headers * fix client requests for :head so it doesn't wait for a body to be returned * fix debugging output when running inside emacs * add client info to documentation. 2000-03-27 John Foderaro 1.1.9 * mainly documentation fixes 2000-03-22 John Foderaro 1.1.8 * fix http/0.9 processing * make errors in http worker threads, if uncaught (see below) and if the emacs-lisp interface is running, cause a new emacs window to appear in which you can debug the problem * add net.iserve::*trap-errors* (default t). If set to nil then errors in http processing by iserve will result in error break loops. * fixed errors in publish-directory. Also prevent user from passing ../ in urls to access above the published directory 2000-03-22 John Foderaro 1.1.7 * make initial lisp listerner of standalone version sleep so that the process can be put in the background. * add t-iserve.cl and begin to add automated tests * add cookies and authorization to client module * load client module into iserve 2000-03-20 John Foderaro 1.1.6 * convert references to neo to iserve * minor fixups in tutorial 2000-03-20 John Foderaro 1.1.5 * include iservelogo.gif in the ftp distribution * fix problem where the response to a file entity request for a file that doesn't exist would cause browser to hang until the socket was closed 2000-03-17 John Foderaro 1.1.4 * change source-readme.txt and load.cl so that it will build on Windows without the unix tools ******************************************************************************* join from acl50 branch - cvs command: cvs update -d -j acl50 - next merge tag: acl50_merge2 ******************************************************************************* 2000-03-15 John Foderaro 1.1.3 * switch to lgpl license. * add source-readme.txt to describe what to do with the source 2000-03-14 John Foderaro 1.1.2 * add authorizer objects to support checking for valid access to pages 2000-03-07 John Foderaro 1.1.1 * load.cl - lisp need not be in the directory containing this file in order to load it (and iserve) * main.cl - get-request-body will not get fooled by :get requests * publish.cl - make virtual hosts work for prefix handlers * doc/iserve.html - update to describe :remove arg to pubilsh functions * doc/tutorial.html - lots more added * examples/tutorial.cl - add sample methods 2000-03-02 jkf * added setuid, setgid args to start * changed the names of the worker processes * changed the names of the slots and accessors holding the commonly used request header info * allowed the :host arg to publish to be a list of host names * for publish-file compute the content-type automatically if not provided 2000-02-25 John Foderaro * added code to the examples so that the pubished url handlers will find the files they reference (if any) no matter what the current directory is when the examples file is loaded. 2000-02-18 John Foderaro * moved examples and doc to their own directories 2000-02-08 John Foderaro 1.1.0 renamed neo to Allegro iServe changed neo package to net.iserve changed htmlgen package to net.html.generator 2000-02-08 John Foderaro 1.0.9 * main.cl - added exports * examples.cl - show how to publish a generated jpg file * neo.html - more documentation 2000-01-28 John Foderaro 1.0.8 * renamed accessors 2000-01-25 John Foderaro * partially added logging 2000-01-25 jkf * use uri package 2000-01-18 John Foderaro 1.0.7 * changed :url to :path in the publish functions * added a locator class to expose the search for a matching entity 2000-01-11 John Foderaro * document accessors. get timedout-response working 1999-12-15 John Foderaro 1.0.6 * cookie support added and documented 1999-12-14 jkf * added new file decode.cl to hold all decode/encode functions 1999-12-11 John Foderaro 1.0.5 * add shutdown command 1999-12-02 John Foderaro 1.0.4 * do case insensitive comparison of mime separation strings. It may not be necessary but it seemed to be for IE. 1999-11-02 John Foderaro 1.0.3 * fixed chunking output calls so it works again 1999-10-15 jkf 1.0.2 * added multipart info grabbing and updated the documentatoin 1999-10-13 John Foderaro 1.0.1 * start changelog cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/aserve-cmu.system000066400000000000000000000042031133377100500246270ustar00rootroot00000000000000;;; -*- mode: lisp -*- (in-package :cl-user) ;; Stig: if clc is present, we're a debian-package ;; Rudi: Not if kludge-no-cclan is also present (see README.cmucl) #+(and common-lisp-controller (not kludge-no-cclan)) (setf (logical-pathname-translations "aserve") '(("examples;**;*.*.*" "/usr/share/doc/cl-aserve/examples/") ("**;*.*.*" "cl-library:;aserve;**;*.*.*") )) (mk:defsystem "ASERVE" :source-pathname #-common-lisp-controller (translate-logical-pathname "aserve:") ;; Stig: somehow things screw up if we translate here #+common-lisp-controller "aserve:" :source-extension "cl" :components (;;#-common-lisp-controller (:module "htmlgen" :components ((:file "htmlgen"))) ;;;; Stig: we might use above.. will check again later ;;#+common-lisp-controller ;;(:file "htmlgen") (:file "macs") (:file "main" :depends-on ("macs")) (:file "headers" :depends-on ("main")) (:file "parse" :depends-on ("main")) (:file "decode" :depends-on ("main")) (:file "publish" :depends-on ("main" "htmlgen")) (:file "authorize" :depends-on ("main" "publish")) (:file "log" :depends-on ("main")) (:file "client" :depends-on ("main")) (:file "proxy" :depends-on ("main"))) ;; Stig: if we're a debian-package we should automagically load acl-compat #+(and common-lisp-controller) :depends-on #+(and common-lisp-controller) (acl-compat) :finally-do (progn (pushnew :aserve *features*))) #+cmu (defun init-aserve-cmu () ;; this isn't strictly necessary, but scheduling feels very coarse ;; without startup-idle-and-top-level-loops, leading to answer delays ;; of about 1s per request. (unless (find-if #'(lambda (proc) (string= (mp:process-name proc) "Top Level Loop")) (mp:all-processes)) (mp::startup-idle-and-top-level-loops))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/aserve-corman.lisp000066400000000000000000000041431133377100500247500ustar00rootroot00000000000000;;;; AllegroServe loader for Corman Lisp - Version 1.0 ;;;; ;;;; Copyright (C) 2000 Christopher Double. All Rights Reserved. ;;;; ;;;; License ;;;; ======= ;;;; This software is provided 'as-is', without any express or implied ;;;; warranty. In no event will the author be held liable for any damages ;;;; arising from the use of this software. ;;;; ;;;; Permission is granted to anyone to use this software for any purpose, ;;;; including commercial applications, and to alter it and redistribute ;;;; it freely, subject to the following restrictions: ;;;; ;;;; 1. The origin of this software must not be misrepresented; you must ;;;; not claim that you wrote the original software. If you use this ;;;; software in a product, an acknowledgment in the product documentation ;;;; would be appreciated but is not required. ;;;; ;;;; 2. Altered source versions must be plainly marked as such, and must ;;;; not be misrepresented as being the original software. ;;;; ;;;; 3. This notice may not be removed or altered from any source ;;;; distribution. ;;;; ;;;; More recent versions of this software may be available at: ;;;; http://www.double.co.nz/cl ;;;; ;;;; Comments, suggestions and bug reports to the author, ;;;; Christopher Double, at: chris@double.co.nz ;;;; ;;;; 03/03/2000 - 1.0 ;;;; Initial release. ;;;; Change the *as-source-directory* constant to ;;;; point to the installation directory of ;;;; the AllegroServe install files. ;;;; ;;;; (in-package :cl-user) (defconstant *as-source-directory* "d:/projects/lisp/portableaserve/") (load (concatenate 'string *as-source-directory* "acl-compat/acl-compat-corman.lisp")) (defconstant *as-files* (list "aserve/htmlgen/htmlgen.cl" "aserve/packages.cl" "aserve/macs.cl" "aserve/main.cl" "aserve/headers.cl" "aserve/parse.cl" "aserve/decode.cl" "aserve/publish.cl" "aserve/authorize.cl" "aserve/log.cl" "aserve/client.cl" "aserve/proxy.cl")) (loop for file in *as-files* do (load (concatenate 'string *as-source-directory* file))) (provide 'allegroserve)cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/aserve-mcl.system000066400000000000000000000031321133377100500246160ustar00rootroot00000000000000;;; -*- mode: lisp -*- (in-package "CL-USER") ;There is a bug in OpenMCL where we can't create directories. ;So we only put the :binary-pathname if the bin/OpenMCL directory is there. (let* ((dir (make-pathname :directory (append (pathname-directory *load-truename*) (list "bin" (lisp-implementation-type))))) (bin-path (list :binary-pathname dir)) (bin-extension nil)) #+openmcl (unless (probe-file dir) (setf bin-path nil)) #+openmcl (setf bin-extension (list :binary-extension "dfsl")) (eval `(mk:defsystem "ASERVE" :source-pathname (translate-logical-pathname "aserve:") :source-extension "cl" ,@bin-path ,@bin-extension :components ((:module "htmlgen" :components ((:file "htmlgen"))) (:file "macs") (:file "main" :depends-on ("macs")) (:file "headers" :depends-on ("main")) (:file "parse" :depends-on ("main")) (:file "decode" :depends-on ("main")) (:file "publish" :depends-on ("htmlgen")) (:file "authorize" :depends-on ("main")) (:file "log" :depends-on ("main")) (:file "client" :depends-on ("main")) (:file "proxy" :depends-on ("main")))) ))cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/aserve.asd000066400000000000000000000114341133377100500232740ustar00rootroot00000000000000;;;; -*- mode: lisp -*- ;;;; ;;;; This as an ASDF system for ASERVE meant to replace ;;;; aserve-cmu.system, but could replace all other systems, too. ;;;; (hint, hint) (defpackage #:aserve-system (:use #:cl #:asdf)) (in-package #:aserve-system) (defclass acl-file (cl-source-file) ()) (defmethod asdf:source-file-type ((c acl-file) (s module)) "cl") ;;;; ignore warnings ;;;; ;;;; FIXME: should better fix warnings instead of ignoring them ;;;; FIXME: (perform legacy-cl-sourcefile) duplicates ASDF code (defclass legacy-acl-source-file (acl-file) () (:documentation "Common Lisp source code module with (non-style) warnings. In contrast to CL-SOURCE-FILE, this class does not think that such warnings indicate failure.")) (defmethod perform ((operation compile-op) (c legacy-acl-source-file)) (let ((source-file (component-pathname c)) (output-file (car (output-files operation c))) (warnings-p nil) (failure-p nil)) (setf (asdf::component-property c 'last-compiled) nil) (handler-bind ((warning (lambda (c) (declare (ignore c)) (setq warnings-p t))) ;; _not_ (or error (and warning (not style-warning))) (error (lambda (c) (declare (ignore c)) (setq failure-p t)))) (compile-file source-file :output-file output-file)) ;; rest of this method is as for CL-SOURCE-FILE (setf (asdf::component-property c 'last-compiled) (file-write-date output-file)) (when warnings-p (case (asdf::operation-on-warnings operation) (:warn (warn "COMPILE-FILE warned while performing ~A on ~A" c operation)) (:error (error 'compile-warned :component c :operation operation)) (:ignore nil))) (when failure-p (case (asdf::operation-on-failure operation) (:warn (warn "COMPILE-FILE failed while performing ~A on ~A" c operation)) (:error (error 'compile-failed :component c :operation operation)) (:ignore nil))))) #+(or lispworks cmu sbcl mcl openmcl clisp) (defsystem aserve :name "AllegroServe (portable)" :author "John K. Foderaro" :version "1.2.35" :licence "LLGPL" :default-component-class acl-file :components ((:file "packages") (:file "macs" :depends-on ("packages")) (:legacy-acl-source-file "main" :depends-on ("macs")) (:file "headers" :depends-on ("main")) (:legacy-acl-source-file "parse" :depends-on ("main")) (:file "decode" :depends-on ("main")) (:file "publish" :depends-on ("main")) (:file "authorize" :depends-on ("main" "publish")) (:file "log" :depends-on ("main")) (:file "client" :depends-on ("main")) (:file "proxy" :depends-on ("main" "headers"))) :depends-on (htmlgen acl-compat) :perform (load-op :after (op aserve) (pushnew :aserve cl:*features*))) #+allegro (defclass original-aserve (asdf:component) ((loaded :initform nil :accessor loaded))) #+allegro (defmethod asdf:perform ((op asdf:load-op) (c original-aserve)) #+common-lisp-controller (c-l-c:original-require 'aserve) #-common-lisp-controller (require 'aserve) (setf (loaded c) t)) #+allegro (defmethod asdf:operation-done-p ((op asdf:load-op) (c original-aserve)) (loaded c)) #+allegro (defmethod asdf:operation-done-p ((op asdf:compile-op) (c original-aserve)) t) #+allegro (defsystem aserve :components ((:original-aserve "dummy"))) ;;; Logical pathname is needed by AllegroServe examples #+(or lispworks cmu mcl openmcl clisp sbcl) (setf (logical-pathname-translations "ASERVE") `( #+ignore ; Don't need this with asdf ("**;*.lisp.*" ;,(logical-pathname "**;*.cl.*") ,(merge-pathnames (make-pathname :host (pathname-host *load-truename*) :directory '(:relative "aserve" :wild-inferiors) :name :wild :type "cl" :version :wild) *load-truename* )) ("**;*.*.*" ,(merge-pathnames (make-pathname :host (pathname-host *load-truename*) :directory '(:relative :wild-inferiors) :name :wild :type :wild :version :wild ;:case :common ) *load-truename*)))) #+cmu (defun cl-user::init-aserve-cmu () ;; this isn't strictly necessary, but scheduling feels very coarse ;; without startup-idle-and-top-level-loops, leading to answer delays ;; of about 1s per request. (unless (find-if #'(lambda (proc) (string= (mp:process-name proc) "Top Level Loop")) (mp:all-processes)) (mp::startup-idle-and-top-level-loops))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/authorize.cl000066400000000000000000000147511133377100500236550ustar00rootroot00000000000000;; -*- mode: common-lisp; package: net.aserve -*- ;; ;; authorize.cl ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA - All rights reserved. ;; copyright (c) 2000-2004 Franz Inc, Oakland, CA - All rights reserved. ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of ;; the GNU Lesser General Public License as published by ;; the Free Software Foundation, as clarified by the AllegroServe ;; prequel found in license-allegroserve.txt. ;; ;; This code 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 ;; Lesser General Public License for more details. ;; ;; Version 2.1 of the GNU Lesser General Public License is in the file ;; license-lgpl.txt that was distributed with this file. ;; If it is not present, you can access it from ;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; $Id: authorize.cl,v 1.8 2005-02-20 12:20:45 rudi Exp $ ;; Description: ;; classes and functions for authorizing access to entities ;;- This code in this file obeys the Lisp Coding Standard found in ;;- http://www.franz.com/~jkf/coding_standards.html ;;- (in-package :net.aserve) (defclass authorizer () ;; denotes information on authorizing access to an entity ;; this is meant to be subclassed with the appropriate slots ;; for the type of authorization to be done ()) ;; - password authorization. ;; (defclass password-authorizer (authorizer) ((allowed :accessor password-authorizer-allowed ;; list of conses (name . password) ;; which are valid name, password pairs for this entity :initarg :allowed :initform nil) (realm :accessor password-authorizer-realm :initarg :realm :initform "AllegroServe") )) (defmethod authorize ((auth password-authorizer) (req http-request) (ent entity)) ;; check if this is valid request, return t if ok ;; and :done if we've sent a request for a new name and password ;; (multiple-value-bind (name password) (get-basic-authorization req) (if* name then (dolist (pair (password-authorizer-allowed auth)) (if* (and (equal (car pair) name) (equal (cdr pair) password)) then (return-from authorize t)))) ;; valid name/password not given, ask for it (with-http-response (req *dummy-computed-entity* :response *response-unauthorized* :format :text) (set-basic-authorization req (password-authorizer-realm auth)) ; this is done to preventing a chunking response which ; confuse the proxy (for now).. (if* (member ':use-socket-stream (request-reply-strategy req)) then (setf (request-reply-strategy req) '(:string-output-stream :post-headers))) (with-http-body (req *dummy-computed-entity*) (html (:html (:body (:h1 "Access is not authorized")))) )) :done)) ;; location authorization ;; we allow access based on where the request is made from. ;; the pattern list is a list of items to match against the ;; ip address of the request. When the first match is made the ;; request is either accepted or denied. ;; ;; the possible items in the list of patterns ;; :accept accept immediately ;; :deny deny immediately ;; (:accept ipaddress [bits]) accept if left 'bits' of the ;; ipaddress match ;; (:deny ipaddress [bits]) deny if the left 'bits' of the ;; ipaddress match ;; ;; bits defaults to 32 ;; the ipaddress can be an ;; integer - the 32 bit ip address ;; string ;; "127.0.0.1" - the dotted notation for an ip address ;; "foo.bar.com" - the name of a machine ;; when the ipaddress is a string it is converted to an integer ;; the first time it is examined. ;; When the string is a machine name then the conversion may or ;; may not work due to the need to access a nameserver to do ;; the lookup. ;; ;; ;; (defclass location-authorizer (authorizer) ((patterns :accessor location-authorizer-patterns ;; list of patterns to match :initarg :patterns :initform nil))) (defmethod authorize ((auth location-authorizer) (req http-request) (ent entity)) (let ((request-ipaddress (acl-compat.socket:remote-host (request-socket req)))) (dolist (pattern (location-authorizer-patterns auth)) (if* (atom pattern) then (case pattern (:accept (return-from authorize t)) (:deny (return-from authorize nil)) (t (warn "bogus authorization pattern: ~s" pattern) (return-from authorize nil))) else (let ((decision (car pattern)) (ipaddress (cadr pattern)) (bits (if* (cddr pattern) then (caddr pattern) else 32))) (if* (not (member decision '(:accept :deny))) then (warn "bogus authorization pattern: ~s" pattern) (return-from authorize nil)) (if* (stringp ipaddress) then ; check for dotted ip address first (let ((newaddr (acl-compat.socket:dotted-to-ipaddr ipaddress :errorp nil))) (if* (null newaddr) then ; success! (ignore-errors (setq newaddr (acl-compat.socket:lookup-hostname ipaddress)))) (if* newaddr then (setf (cadr pattern) (setq ipaddress newaddr)) else ; can't compute the address ; so we'll not accept and we will deny ; just to be safe (warn "can't resolve host name ~s" ipaddress) (return-from authorize nil)))) (if* (not (and (integerp bits) (<= 1 bits 32))) then (warn "bogus authorization pattern: ~s" pattern) (return-from authorize nil)) ; now we're finally ready to test things (let ((mask (if* (eql bits 32) then -1 else (ash -1 (- 32 bits))))) (if* (eql (logand request-ipaddress mask) (logand ipaddress mask)) then ; matched, (case decision (:accept (return-from authorize t)) (:deny (return-from authorize nil)))))))) t ; the default is to accept )) ;; - function authorization (defclass function-authorizer (authorizer) ((function :accessor function-authorizer-function :initarg :function :initform nil))) (defmethod authorize ((auth function-authorizer) (req http-request) (ent entity)) (let ((fun (function-authorizer-function auth))) (if* fun then (funcall fun req ent auth)))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/cgi.cl000066400000000000000000000322321133377100500223770ustar00rootroot00000000000000;; -*- mode: common-lisp; package: net.aserve -*- ;; ;; cgi.cl ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA - All rights reserved. ;; copyright (c) 2000-2004 Franz Inc, Oakland, CA - All rights reserved. ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of ;; the GNU Lesser General Public License as published by ;; the Free Software Foundation, as clarified by the AllegroServe ;; prequel found in license-allegroserve.txt. ;; ;; This code 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 ;; Lesser General Public License for more details. ;; ;; Version 2.1 of the GNU Lesser General Public License is in the file ;; license-lgpl.txt that was distributed with this file. ;; If it is not present, you can access it from ;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; ;; $Id: cgi.cl,v 1.9 2005-02-20 12:20:45 rudi Exp $ ;; Description: ;; common gateway interface (running external programs) ;;- This code in this file obeys the Lisp Coding Standard found in ;;- http://www.franz.com/~jkf/coding_standards.html ;;- (in-package :net.aserve) (defun run-cgi-program (req ent program &key path-info path-translated (script-name (puri:uri-path (request-uri req))) (query-string nil query-string-p) auth-type (timeout 200) error-output env ) ;; program is a string naming a external command to run. ;; invoke the program after setting all of the environment variables ;; according to the cgi specification. ;; http://hoohoo.ncsa.uiuc.edu/cgi/interface.html ;; ;; error-output can be ;; nil - inherit lisp's standard output ;; pathname or string - write to file of a given name ;; :output - mix in the error output with the output ;; function - call function when input's available from the error ;; stream (let ((envs (list '("GATEWAY_INTERFACE" . "CGI/1.1") `("SERVER_SOFTWARE" . ,(format nil "AllegroServe/~a" *aserve-version-string*)))) (error-output-arg) (error-fcn) (body)) ; error check the error argument (typecase error-output ((or null pathname string) (setq error-output-arg error-output)) (symbol (if* (eq error-output :output) then (setq error-output-arg error-output) else (setq error-output-arg :stream error-fcn error-output))) (function (setq error-output-arg :stream error-fcn error-output)) (t (error "illegal value for error-output: ~s" error-output))) (let ((our-ip (acl-compat.socket:local-host (request-socket req)))) (let ((hostname (acl-compat.socket:ipaddr-to-hostname our-ip))) (if* (null hostname) then (setq hostname (acl-compat.socket:ipaddr-to-dotted our-ip))) (push (cons "SERVER_NAME" hostname) envs))) (push (cons "SERVER_PROTOCOL" (string-upcase (string (request-protocol req)))) envs) (push (cons "SERVER_PORT" (write-to-string (acl-compat.socket:local-port (request-socket req)))) envs) (push (cons "REQUEST_METHOD" (string-upcase (string (request-method req)))) envs) (if* path-info then (push (cons "PATH_INFO" path-info) envs)) (if* path-translated then (push (cons "PATH_INFO" path-translated) envs)) (if* script-name then (push (cons "SCRIPT_NAME" script-name) envs)) (if* query-string-p then (if* query-string then (push (cons "QUERY_STRING" query-string) envs)) else ; no query string arg given, see if the uri ; for ths command has a query string (let ((query (puri:uri-query (request-uri req)))) (if* query then (push (cons "QUERY_STRING" query) envs)))) (let ((their-ip (acl-compat.socket:remote-host (request-socket req)))) (let ((hostname (acl-compat.socket:ipaddr-to-hostname their-ip))) (if* hostname then (push (cons "REMOTE_HOST" hostname) envs))) (push (cons "REMOTE_ADDR" (acl-compat.socket:ipaddr-to-dotted their-ip)) envs)) (if* auth-type then (push (cons "AUTH_TYPE" auth-type) envs)) (if* (member (request-method req) '(:put :post)) then ; there is likely data coming along (setq body (get-request-body req )) (if* (equal body "") then (setq body nil)) ; trivial case (let ((content-type (header-slot-value req :content-type))) (if* content-type then (push (cons "CONTENT_TYPE" content-type) envs)) (push (cons "CONTENT_LENGTH" (princ-to-string (if* body then (length body) else 0))) envs))) ; now do the rest of the headers. (dolist (head (listify-parsed-header-block (request-header-block req))) (if* (and (not (member (car head) '(:content-type :content-length) :test #'eq)) (cdr head)) then (push (cons (format nil "HTTP_~a" (substitute #\_ #\- (string-upcase (string (car head))))) (cdr head)) envs))) (dolist (header env) (if* (not (and (consp header) (stringp (car header)) (stringp (cdr header)))) then (error "bad form for environment value: ~s" header)) (let ((ent (assoc (car header) envs :test #'equal))) (if* ent then ; replace value with user specified value (setf (cdr ent) (cdr header)) else ; add new value (push header envs)))) ;; now to invoke the program ;; this requires acl6.1 on unix since this is the first version ;; that can set the environment variables for the run-shell-command ;; call (multiple-value-bind (to-script-stream from-script-stream from-script-error-stream pid) (run-shell-command program :input (if* body then :stream) :output :stream :error-output error-output-arg :separate-streams t :wait nil :environment envs :show-window :hide) (declare (ignore ignore-this)) (unwind-protect ; first send the body to the script ; maybe we should interleave reading and writing ; but that's a lot of work (progn (ignore-errors (if* (and body to-script-stream) then (write-sequence body to-script-stream))) (if* to-script-stream then (ignore-errors (close to-script-stream)) (setq to-script-stream nil)) ; read the output from the script (read-script-data req ent from-script-stream from-script-error-stream error-fcn timeout)) ;; cleanup forms: (if* to-script-stream then (ignore-errors (close to-script-stream))) (if* from-script-stream then (ignore-errors (close from-script-stream))) (if* from-script-error-stream then (ignore-errors (close from-script-error-stream))) (if* pid then ;; it may be bad to wait here... (acl-compat.mp:with-timeout (60) ; ok w-t (acl-compat.sys:reap-os-subprocess :pid pid :wait t))))))) (defun read-script-data (req ent stream error-stream error-fcn timeout) ;; read from the stream and the error-stream (if given) ;; do the cgi header processing and start sending output asap ;; ;; don't close the streams passed, they'll be closed by the caller ;; (let ((active-streams) (buff) (start 0)) (labels ((error-stream-handler () ;; called when data available on error stream. ;; calls user supplied handler function (let ((retcode (funcall error-fcn req ent error-stream))) (if* retcode then ; signal to close off the error stream (setq active-streams (delete error-stream active-streams :key #'car))))) (data-stream-header-read () ;; called when data available on standard output ;; and we're still reading in search of a full header ;; (if* (>= start (length buff)) then ; no more room to read, must be bogus header (failed-script-response req ent) (return-from read-script-data) else (let ((len (read-vector buff stream :start start))) (if* (<= len start) then ; eof, meaning no header (failed-script-response req ent) (return-from read-script-data) else (setq start len) (multiple-value-bind (resp headers bodystart) (parse-cgi-script-data buff start) (if* resp then ; got the header, switch ; to body (data-stream-body-process resp headers bodystart) ; never returns )))))) (data-stream-body-process (resp headers bodystart) ;; called when it's time to start returning the body (with-http-response (req ent :response resp :format :binary) (with-http-body (req ent :headers headers) ; write out first block (write-all-vector buff *html-stream* :start bodystart :end start) ; now loop and read rest (setf (cdr (assoc stream active-streams :test #'eq)) #'data-stream-body) (loop (if* (null active-streams) then (return)) (let ((active (acl-compat.mp:wait-for-input-available (mapcar #'car active-streams) :timeout timeout))) (if* (null active) then ; timeout, just shut down streams (setq active-streams nil) else ; run handlers (mapc #'(lambda (x) (funcall (cdr (assoc x active-streams :test #'eq)))) active) ))))) (return-from read-script-data)) (data-stream-body () ;; process data coming back from the body (let ((len (read-vector buff stream))) (if* (<= len 0) then ; end of file, remove this stream (setq active-streams (delete stream active-streams :key #'car)) else ; send data to output (write-all-vector buff *html-stream* :start 0 :end len) (force-output *html-stream*))))) (setq active-streams (list (cons stream #'data-stream-header-read))) (if* error-stream then (push (cons error-stream #'error-stream-handler) active-streams)) (unwind-protect (progn (setq buff (get-header-block)) (loop ; this loop is for searching for a valid header (let ((active (acl-compat.mp:wait-for-input-available (mapcar #'car active-streams) :timeout timeout))) (if* (null active) then ; must have timed out (failed-script-response req ent) (return-from read-script-data)) ; run the handlers (mapc #'(lambda (x) (funcall (cdr (assoc x active-streams :test #'eq)))) active)))) ; cleanup (free-header-block buff))))) (defun failed-script-response (req ent) ;; send back a generic failed message (with-http-response (req ent :response *response-internal-server-error* :content-type "text/html") (with-http-body (req ent) (html "The cgi script failed to run")))) (defun parse-cgi-script-data (buff end) ;; if there's a valid header block in the buffer from 0 to end-1 ;; then return ;; 1. the response object denoting the response value to send back ;; 2. a list of headers and values ;; 3. the index in the buffer where the data begins after the header ;; ;; else return nil (let* ((loc (search *crlf-crlf-usb8* buff :end2 (min (length buff) end))) (loclflf (and (null loc) ;; maybe uses bogus lf-lf to end headers (search *lf-lf-usb8* buff :end2 (min (length buff) end)))) (incr 2)) (if* loclflf then (setq loc loclflf incr 1)) (if* (null loc) then ; hmm.. no headers..bogus return ;(warn "no headers found") (return-from parse-cgi-script-data nil)) (incf loc incr) ; after last header crlf (lf), before final crlf (lf) (let ((headers (parse-and-listify-header-block buff loc)) (resp *response-ok*)) (incf loc incr) ; past the final crlf (lf) (if* (assoc :location headers :test #'eq) then (setq resp *response-moved-permanently*)) (let ((status (assoc :status headers :test #'eq)) code reason) (if* status then (ignore-errors (setq code (read-from-string (cdr status)))) (if* (not (integerp code)) then ; bogus status value, just return nil ; eventually we'll get a failed response (logmess (format nil "cgi script return bogus status value: ~s" code)) (return-from parse-cgi-script-data nil)) (let ((space (position #\space (cdr status)))) (if* space then (setq reason (subseq (cdr status) space)))) (setq resp (make-resp code reason)) (setq headers (delete status headers)))) (values resp headers loc)))) (defun write-all-vector (sequence stream &key (start 0) (end (length sequence))) ;; write everything in the vector before returning (loop (if* (< start end) then (setq start (write-vector sequence stream :start start :end end)) else (return))) end) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/client.cl000066400000000000000000000741641133377100500231250ustar00rootroot00000000000000;; -*- mode: common-lisp; package: net.aserve.client -*- ;; ;; client.cl ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA - All rights reserved. ;; copyright (c) 2000-2004 Franz Inc, Oakland, CA - All rights reserved. ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of ;; the GNU Lesser General Public License as published by ;; the Free Software Foundation, as clarified by the AllegroServe ;; prequel found in license-allegroserve.txt. ;; ;; This code 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 ;; Lesser General Public License for more details. ;; ;; Version 2.1 of the GNU Lesser General Public License is in the file ;; license-lgpl.txt that was distributed with this file. ;; If it is not present, you can access it from ;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; ;; $Id: client.cl,v 1.19 2007-02-25 12:21:52 rudi Exp $ ;; Description: ;; http client code. ;;- This code in this file obeys the Lisp Coding Standard found in ;;- http://www.franz.com/~jkf/coding_standards.html ;;- ;; this will evolve into the http client code but for now it's ;; just some simple stuff to allow us to test aserve ;; (in-package :net.aserve.client) (defclass client-request () ((uri ;; uri we're accessing :initarg :uri :accessor client-request-uri) (method ; :get, :put, etc :initarg :method :accessor client-request-method) (headers ; alist of ("headername" . "value") :initform nil :initarg :headers :accessor client-request-headers) (response-code ; response code (an integer) :initform nil :accessor client-request-response-code) (socket ; the socket through which we'll talk to the server :initarg :socket :accessor client-request-socket) (protocol ; the protocol value returned by the web server ; note, even if the request is for http/1.0, apache will return ; http/1.1. I'm not sure this is kosher. :accessor client-request-protocol) (response-comment ;; comment passed back with the response :accessor client-request-response-comment) ; (bytes-left ;; indicates how many bytes in response left ; value is nil (no body) ; integer (that many bytes left, not chunking) ; :unknown - read until eof, not chunking ; :chunking - read until chunking eof :accessor client-request-bytes-left :initform nil) (cookies ;; optionally a cookie jar for hold received and sent cookies :accessor client-request-cookies :initarg :cookies :initform nil) )) (defvar crlf (make-array 2 :element-type 'character :initial-contents '(#\return #\linefeed))) (defmacro with-better-scan-macros (&body body) ;; define the macros for scanning characters in a string `(macrolet ((collect-to (ch buffer i max &optional downcasep) ;; return a string containing up to the given char `(let ((start ,i)) (loop (if* (>= ,i ,max) then (fail)) (if* (eql ,ch (schar ,buffer ,i)) then (return (buf-substr start ,i ,buffer ,downcasep))) (incf ,i) ))) (collect-to-eol (buffer i max) ;; return a string containing up to the given char `(let ((start ,i)) (loop (if* (>= ,i ,max) then (return (buf-substr start ,i ,buffer))) (let ((thisch (schar ,buffer ,i))) (if* (eq thisch #\return) then (let ((ans (buf-substr start ,i ,buffer))) (incf ,i) ; skip to linefeed (return ans)) elseif (eq thisch #\linefeed) then (return (buf-substr start ,i ,buffer)))) (incf ,i) ))) (skip-to-not (ch buffer i max &optional (errorp t)) ;; skip to first char not ch `(loop (if* (>= ,i ,max) then ,(if* errorp then `(fail) else `(return))) (if* (not (eq ,ch (schar ,buffer ,i))) then (return)) (incf ,i))) (buf-substr (from to buffer &optional downcasep) ;; create a string containing [from to } ;; `(let ((res (make-string (- ,to ,from)))) (do ((ii ,from (1+ ii)) (ind 0 (1+ ind))) ((>= ii ,to)) (setf (schar res ind) ,(if* downcasep then `(char-downcase (schar ,buffer ii)) else `(schar ,buffer ii)))) res))) ,@body)) (defun do-http-request (uri &rest args &key (method :get) (protocol :http/1.1) (accept "*/*") content content-type query (format :text) ; or :binary cookies ; nil or a cookie-jar (redirect 5) ; auto redirect if needed (redirect-methods '(:get :head)) basic-authorization ; (name . password) keep-alive ; if true, set con to keep alive headers ; extra header lines, alist proxy ; naming proxy server to access through user-agent (external-format *default-aserve-external-format*) ssl ; do an ssl connection skip-body ; fcn of request object ) ;; send an http request and return the result as four values: ;; the body, the response code, the headers and the uri (let ((creq (make-http-client-request uri :method method :protocol protocol :accept accept :content content :content-type content-type :query query :cookies cookies :basic-authorization basic-authorization :keep-alive keep-alive :headers headers :proxy proxy :user-agent user-agent :external-format external-format :ssl ssl ))) (unwind-protect (let (new-location) (loop (read-client-response-headers creq) ;; if it's a continue, then start the read again (if* (not (eql 100 (client-request-response-code creq))) then (return))) (if* (and (member (client-request-response-code creq) '(#.(net.aserve::response-number *response-found*) #.(net.aserve::response-number *response-moved-permanently*) #.(net.aserve::response-number *response-temporary-redirect*) #.(net.aserve::response-number *response-see-other*)) :test #'eq) redirect (member method redirect-methods :test #'eq) (if* (integerp redirect) then (> redirect 0) else t)) ; unrestricted depth then (setq new-location (cdr (assoc :location (client-request-headers creq) :test #'eq)))) (if* (and (null new-location) ; not called when redirecting (if* (functionp skip-body) then (funcall skip-body creq) else skip-body)) then (return-from do-http-request (values nil ; no body (client-request-response-code creq) (client-request-headers creq) (client-request-uri creq)))) ;; read the body of the response (let ( #+ignore (atype (if* (eq format :text) ; JSC: We do not need to set this all over and over then 'character else '(unsigned-byte 8))) ans res (start 0) (end nil) body) (loop (if* (null ans) then (setq ans (make-array 1024 :element-type '(unsigned-byte 8)) ; was atype) start 0)) (setq end (client-request-read-sequence ans creq :start start)) (if* (zerop end) then ; eof (return)) (if* (eql end 1024) then ; filled up (push ans res) (setq ans nil) else (setq start end))) ;; we're out with res containing full arrays and ;; ans either nil or holding partial data up to but not including ;; index start (if* res then ; multiple items (let* ((total-size (+ (* 1024 (length res)) start)) (bigarr (make-array total-size :element-type '(unsigned-byte 8)) ; was atype) )) (let ((sstart 0)) (dolist (arr (reverse res)) (replace bigarr arr :start1 sstart) (incf sstart (length arr))) (if* ans then ; final one (replace bigarr ans :start1 sstart))) (setq body bigarr)) else ; only one item (if* (eql 0 start) then ; nothing returned (setq body "") else (setq body (subseq ans 0 start)))) (if* new-location then ; must do a redirect to get to the real site (client-request-close creq) (apply #'do-http-request (puri:merge-uris new-location uri) :redirect (if* (integerp redirect) then (1- redirect) else redirect) args) else (values (if (eq format :text) (let ((result (make-string (length body)))) (map-into result #'code-char body) result) body) (client-request-response-code creq) (client-request-headers creq) (client-request-uri creq))))) ;; protected form: (client-request-close creq)))) (defun make-http-client-request (uri &key (method :get) ; :get, :post, .... (protocol :http/1.1) keep-alive (accept "*/*") cookies ; nil or a cookie-jar basic-authorization content content-length content-type query headers proxy user-agent (external-format *default-aserve-external-format*) ssl ) (let (host sock port fresh-uri scheme-default-port) ;; start a request ; parse the uri we're accessing (if* (not (typep uri 'puri:uri)) then (setq uri (puri:parse-uri uri) fresh-uri t)) ; make sure it's an http uri (case (or (puri:uri-scheme uri) :http) (:http nil) (:https (setq ssl t)) (t (error "Can only do client access of http or https uri's, not ~s" uri))) ; make sure that there's a host (if* (null (setq host (puri:uri-host uri))) then (error "need a host in the client request: ~s" uri)) (setq scheme-default-port (case (or (puri:uri-scheme uri) (if* ssl then :https else :http)) (:http 80) (:https 443))) ; default the port to what's appropriate for http or https (setq port (or (puri:uri-port uri) scheme-default-port)) (if* proxy then ; sent request through a proxy server (assert (stringp proxy) (proxy) "proxy value ~s should be a string" proxy) (multiple-value-bind (phost pport) (net.aserve::get-host-port proxy) (if* (null phost) then (error "proxy arg should have form \"foo.com\" ~ or \"foo.com:8000\", not ~s" proxy)) (setq sock (acl-compat.socket:make-socket :remote-host phost :remote-port pport :format :bivalent :type net.aserve::*socket-stream-type* :nodelay t ))) else (setq sock (acl-compat.socket:make-socket :remote-host host :remote-port port :format :bivalent :type net.aserve::*socket-stream-type* :nodelay t )) (if* ssl then (setq sock (funcall 'acl-compat.socket::make-ssl-client-stream sock))) ) #+(and allegro (version>= 6 0)) (let ((ef (find-external-format external-format))) #+(and allegro (version>= 6)) (net.aserve::warn-if-crlf ef) (setf (stream-external-format sock) ef)) #+allegro (if* net.aserve::*watch-for-open-sockets* then (schedule-finalization sock #'net.aserve::check-for-open-socket-before-gc)) (if* query then (case method ((:get :put) ; add info the uri ; must not blast a uri we were passed (if* (not fresh-uri) then (setq uri (puri:copy-uri uri))) (setf (puri:uri-query uri) (query-to-form-urlencoded query :external-format external-format))) (:post ; make the content (if* content then (error "Can't specify both query ~s and content ~s" query content)) (setq content (query-to-form-urlencoded query :external-format external-format) content-type "application/x-www-form-urlencoded")))) (net.aserve::format-dif :xmit sock "~a ~a ~a~a" (string-upcase (string method)) (if* proxy then (puri:render-uri uri nil) else (uri-path-etc uri)) (string-upcase (string protocol)) crlf) ; always send a Host header, required for http/1.1 and a good idea ; for http/1.0 (if* (not (eql scheme-default-port port)) then (net.aserve::format-dif :xmit sock "Host: ~a:~a~a" host port crlf) else (net.aserve::format-dif :xmit sock "Host: ~a~a" host crlf)) ; now the headers (if* keep-alive then (net.aserve::format-dif :xmit sock "Connection: Keep-Alive~a" crlf)) (if* accept then (net.aserve::format-dif :xmit sock "Accept: ~a~a" accept crlf)) ; content can be a nil, a single vector or a list of vectors. ; canonicalize.. (if* (and content (atom content)) then (setq content (list content))) (if* content then (let ((computed-length 0)) (dolist (content-piece content) (typecase content-piece ;;added for paserve - in some lisps (e.g. mcl) ;;strings are not character arrays ((or (array character (*)) (array base-char (*))) (if* (null content-length) then (incf computed-length #+allegro (native-string-sizeof content-piece :external-format external-format) #-allegro (length content-piece)))) ((array (unsigned-byte 8) (*)) (if* (null content-length) then (incf computed-length (length content-piece)))) (t (error "Illegal content array: ~s" content-piece)))) (if* (null content-length) then (setq content-length computed-length)))) (if* content-length then (net.aserve::format-dif :xmit sock "Content-Length: ~s~a" content-length crlf)) (if* cookies then (let ((str (compute-cookie-string uri cookies))) (if* str then (net.aserve::format-dif :xmit sock "Cookie: ~a~a" str crlf)))) (if* basic-authorization then (net.aserve::format-dif :xmit sock "Authorization: Basic ~a~a" (base64-encode (format nil "~a:~a" (car basic-authorization) (cdr basic-authorization))) crlf)) (if* user-agent then (if* (stringp user-agent) thenret elseif (eq :aserve user-agent) then (setq user-agent net.aserve::*aserve-version-string*) elseif (eq :netscape user-agent) then (setq user-agent "Mozilla/4.7 [en] (WinNT; U)") elseif (eq :ie user-agent) then (setq user-agent "Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0)") else (error "Illegal user-agent value: ~s" user-agent)) (net.aserve::format-dif :xmit sock "User-Agent: ~a~a" user-agent crlf)) (if* content-type then (net.aserve::format-dif :xmit sock "Content-Type: ~a~a" content-type crlf)) (if* headers then (dolist (header headers) (net.aserve::format-dif :xmit sock "~a: ~a~a" (car header) (cdr header) crlf))) (write-string crlf sock) ; final crlf ; send out the content if there is any. ; this has to be done differently so that if it looks like we're ; going to block doing the write we start another process do the ; the write. (if* content then ; content can be a vector a list of vectors (if* (atom content) then (setq content (list content))) (dolist (cont content) (net.aserve::if-debug-action :xmit (format net.aserve::*debug-stream* "client sending content of ~d characters/bytes" (length cont))) (write-sequence cont sock))) (force-output sock) (make-instance 'client-request :uri uri :socket sock :cookies cookies :method method ))) (defun uri-path-etc (uri) ;; return the string form of the uri path, query and fragment (let ((nuri (puri:copy-uri uri))) (setf (puri:uri-scheme nuri) nil) (setf (puri:uri-host nuri) nil) (setf (puri:uri-port nuri) nil) (if* (null (puri:uri-path nuri)) then (setf (puri:uri-path nuri) "/")) (puri:render-uri nuri nil))) (defmethod read-client-response-headers ((creq client-request)) ;; read the response and the headers (let ((buff (get-header-line-buffer)) (buff2 (get-header-line-buffer)) (pos 0) len (sock (client-request-socket creq)) (headers) protocol response comment val ) (unwind-protect (with-better-scan-macros (if* (null (setq len (read-socket-line sock buff (length buff)))) then ; eof getting response (error "premature eof from server")) (macrolet ((fail () `(let ((i 0)) (error "illegal response from web server: ~s" (collect-to-eol buff i len))))) (setq protocol (collect-to #\space buff pos len)) (skip-to-not #\space buff pos len) (setq response (collect-to #\space buff pos len)) ; some servers don't return a comment, so handle that (skip-to-not #\space buff pos len nil) (setq comment (collect-to-eol buff pos len))) (if* (equalp protocol "HTTP/1.0") then (setq protocol :http/1.0) elseif (equalp protocol "HTTP/1.1") then (setq protocol :http/1.1) else (error "unknown protocol: ~s" protocol)) (setf (client-request-protocol creq) protocol) (setf (client-request-response-code creq) (quick-convert-to-integer response)) (setf (client-request-response-comment creq) comment) ; now read the header lines (setq headers (net.aserve::compute-client-request-headers sock)) (setf (client-request-headers creq) headers) ;; do cookie processing (let ((jar (client-request-cookies creq))) (if* jar then ; do all set-cookie requests (let (prev) ; Netscape v3 web server bogusly splits set-cookies ; over multiple set-cookie lines, so we look for ; incomplete lines (those ending in #\;) and combine ; them with the following set-cookie (dolist (headval headers) (if* (eq :set-cookie (car headval)) then (if* prev then (setq prev (concatenate 'string prev (cdr headval))) else (setq prev (cdr headval))) (if* (not (eq #\; (last-character prev))) then (save-cookie (client-request-uri creq) jar prev) (setq prev nil))))))) (if* (eq :head (client-request-method creq)) then ; no data is returned for a head request (setf (client-request-bytes-left creq) 0) elseif (equalp "chunked" (client-response-header-value creq :transfer-encoding)) then ; data will come back in chunked style (setf (client-request-bytes-left creq) :chunked) (acl-compat.socket:socket-control (client-request-socket creq) :input-chunking t) elseif (setq val (client-response-header-value creq :content-length)) then ; we know how many bytes are left (setf (client-request-bytes-left creq) (quick-convert-to-integer val)) elseif (not (equalp "keep-alive" (client-response-header-value creq :connection))) then ; connection will close, let it indicate eof (setf (client-request-bytes-left creq) :unknown) else ; no data in the response nil) creq ; return the client request object ) (progn (put-header-line-buffer buff2 buff))))) (defmethod client-request-read-sequence (buffer (creq client-request) &key (start 0) (end (length buffer))) ;; read the next (end-start) bytes from the body of client request, handling ;; turning on chunking if needed ;; return index after last byte read. ;; return 0 if eof (let ((bytes-left (client-request-bytes-left creq)) (socket (client-request-socket creq)) (last start)) (if* (integerp bytes-left) then ; just a normal read-sequence (if* (zerop bytes-left) then 0 ; eof else (let ((ans (net.aserve::rational-read-sequence buffer socket :start start :end (+ start (min (- end start) bytes-left))))) (if* (eq ans start) then 0 ; eof else (net.aserve::if-debug-action :xmit (write-sequence buffer net.aserve::*debug-stream* :start start :end ans)) (setf (client-request-bytes-left creq) (- bytes-left (- ans start))) ans))) elseif (or (eq bytes-left :chunked) (eq bytes-left :unknown)) then (handler-case (do ((i start (1+ i)) (stringp (stringp buffer)) (debug-on (member :xmit net.aserve::*debug-current* :test #'eq))) ((>= i end) (setq last end)) (setq last i) (let ((ch (if* stringp then (read-char socket nil nil) else (read-byte socket nil nil)))) (if* (null ch) then (return) else (if* debug-on then (write-char (if* (characterp ch) then ch else (code-char ch)) net.aserve::*debug-stream*)) (setf (aref buffer i) ch)))) (acl-compat.excl::socket-chunking-end-of-file (cond) (declare (ignore cond)) ; remember that there is no more data left (setf (client-request-bytes-left creq) :eof) nil)) ; we return zero on eof, regarless of the value of start ; I think that this is ok, the spec isn't completely clear (if* (eql last start) then 0 else last) elseif (eq bytes-left :eof) then 0 else (error "socket not setup for read correctly") ))) (defmethod client-request-close ((creq client-request)) (let ((sock (client-request-socket creq))) (if* sock then (setf (client-request-socket creq) nil) (ignore-errors (force-output sock)) (ignore-errors (close sock))))) (defun quick-convert-to-integer (str) ; take the simple string and convert it to an integer ; it's assumed to be a positive number ; no error checking is done. (let ((res 0)) (dotimes (i (length str)) (let ((chn (- (char-code (schar str i)) #.(char-code #\0)))) (if* (<= 0 chn 9) then (setq res (+ (* 10 res) chn))))) res)) (defmethod client-response-header-value ((creq client-request) name &key parse) ;; return the value associated with the given name ;; parse it too if requested (if* (stringp name) then (error "client-response headers are now named by symbols, not strings")) (let ((val (cdr (assoc name (client-request-headers creq) :test #'eq)))) (if* (and parse val) then (net.aserve::parse-header-value val) else val))) (defun read-socket-line (socket buffer max) ;; read the next line from the socket. ;; the line may end with a linefeed or a return, linefeed, or eof ;; in any case don't put that the end of line characters in the buffer ;; return the number of characters in the buffer which will be zero ;; for an empty line. ;; on eof return nil ;; JSC Note: This function is only used for reading headers. Therefore we ;; are safe in always doing CODE->CHAR conversions here. (let ((i 0)) (loop (let* ((ch (read-byte socket nil nil)) (ch (and ch (code-char ch)))) (if* (null ch) then ; eof from socket (if* (> i 0) then ; actually read some stuff first (return i) else (return nil) ; eof ) elseif (eq ch #\return) thenret ; ignore elseif (eq ch #\linefeed) then ; end of the line, (return i) elseif (< i max) then ; ignore characters beyone line end (setf (schar buffer i) ch) (incf i)))))) ;; buffer pool for string buffers of the right size for a header ;; line (defvar *response-header-buffers* nil) (defvar *response-header-pool-lock* (acl-compat.mp:make-process-lock :name "ACLCompat response header buffer spool lock")) (defun get-header-line-buffer () ;; return the next header line buffer (let (buff) (acl-compat.mp:with-process-lock (*response-header-pool-lock*) (acl-compat.excl::fast (setq buff (pop *response-header-buffers*)))) (if* buff thenret else (make-array 400 :element-type 'character)))) (defun put-header-line-buffer (buff &optional buff2) ;; put back up to two buffers (acl-compat.mp:with-process-lock (*response-header-pool-lock*) (push buff *response-header-buffers*) (if* buff2 then (push buff2 *response-header-buffers*)))) ;;;;; cookies (defclass cookie-jar () ;; holds all the cookies we've received ;; items is a alist where each item has the following form: ;; (hostname cookie-item ...) ;; ;; where hostname is a string that must be the suffix ;; of the requesting host to match ;; path is a string that must be the prefix of the requesting host ;; to match ;; ;; ((items :initform nil :accessor cookie-jar-items))) (defmethod print-object ((jar cookie-jar) stream) (print-unreadable-object (jar stream :type t :identity t) (format stream "~d cookies" (length (cookie-jar-items jar))))) ;* for a given hostname, there will be only one cookie with ; a given (path,name) pair ; (defstruct cookie-item path ; a string that must be the prefix of the requesting host to match name ; the name of this cookie value ; the value of this cookie expires ; when this cookie expires secure ; t if can only be sent over a secure server ) (defmethod save-cookie (uri (jar cookie-jar) cookie) ;; we've made a request to the given host and gotten back ;; a set-cookie header with cookie as the value ;; jar is the cookie jar into which we want to store the cookie (let* ((pval (car (net.aserve::parse-header-value cookie t))) namevalue others path domain ) (if* (consp pval) then ; (:param namevalue . etc) (setq namevalue (cadr pval) others (cddr pval)) elseif (stringp pval) then (setq namevalue pval) else ; nothing here (return-from save-cookie nil)) ;; namevalue has the form name=value (setq namevalue (net.aserve::split-on-character namevalue #\= :count 1)) ;; compute path (setq path (cdr (net.aserve::assoc-paramval "path" others))) (if* (null path) then (setq path (or (puri:uri-path uri) "/")) else ; make sure it's a prefix (if* (not (net.aserve::match-head-p path (or (puri:uri-path uri) "/"))) then ; not a prefix, don't save (return-from save-cookie nil))) ;; compute domain (setq domain (cdr (net.aserve::assoc-paramval "domain" others))) (if* domain then ; one is given, test to see if it's a substring ; of the host we used (if* (null (net.aserve::match-tail-p domain (puri:uri-host uri))) then (return-from save-cookie nil)) else (setq domain (puri:uri-host uri))) (let ((item (make-cookie-item :path path :name (car namevalue) :value (or (cadr namevalue) "") :secure (net.aserve::assoc-paramval "secure" others) :expires (cdr (net.aserve::assoc-paramval "expires" others)) ))) ; now put in the cookie jar (let ((domain-vals (assoc domain (cookie-jar-items jar) :test #'equal))) (if* (null domain-vals) then ; this it the first time for this host (push (list domain item) (cookie-jar-items jar)) else ; this isn't the first ; check for matching path and name (do* ((xx (cdr domain-vals) (cdr xx)) (thisitem (car xx) (car xx))) ((null xx) ) (if* (and (equal (cookie-item-path thisitem) path) (equal (cookie-item-name thisitem) (car namevalue))) then ; replace this one (setf (car xx) item) (return-from save-cookie nil))) ; no match, must insert based on the path length (do* ((prev nil xx) (xx (cdr domain-vals) (cdr xx)) (thisitem (car xx) (car xx)) (length (length path))) ((null xx) ; put at end (if* (null prev) then (setq prev domain-vals)) (setf (cdr prev) (cons item nil))) (if* (>= (length (cookie-item-path thisitem)) length) then ; can insert here (if* prev then (setf (cdr prev) (cons item xx)) else ; at the beginning (setf (cdr domain-vals) (cons item (cdr domain-vals)))) (return-from save-cookie nil)))))))) (defparameter cookie-separator ;; useful for separating cookies, one per line (make-array 10 :element-type 'character :initial-contents '(#\return #\linefeed #\C #\o #\o #\k #\i #\e #\: #\space))) (defmethod compute-cookie-string (uri (jar cookie-jar)) ;; compute a string of the applicable cookies. ;; (let ((host (puri:uri-host uri)) (path (or (puri:uri-path uri) "/")) res rres) (dolist (hostval (cookie-jar-items jar)) (if* (net.aserve::match-tail-p (car hostval) host) then ; ok for this host (dolist (item (cdr hostval)) (if* (net.aserve::match-head-p (cookie-item-path item) path) then ; this one matches (push item res))))) (if* res then ; have some cookies to return #+ignore (dolist (item res) (push (cookie-item-value item) rres) (push "=" rres) (push (cookie-item-name item) rres) (push semicrlf rres)) (dolist (item res) (push (cookie-item-value item) rres) (push "=" rres) (push (cookie-item-name item) rres) (push cookie-separator rres)) (pop rres) ; remove first seperator (apply #'concatenate 'string rres)))) (defun last-character (string) ;; return the last non blank character, or nil (do ((i (1- (length string)) (1- i)) (ch)) ((< i 0) nil) (setq ch (schar string i)) (if* (eq #\space ch) thenret else (return ch)))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/decode.cl000066400000000000000000000554021133377100500230640ustar00rootroot00000000000000;; -*- mode: common-lisp; package: net.aserve -*- ;; ;; decode.cl ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA - All rights reserved. ;; copyright (c) 2000-2004 Franz Inc, Oakland, CA - All rights reserved. ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of ;; the GNU Lesser General Public License as published by ;; the Free Software Foundation, as clarified by the AllegroServe ;; prequel found in license-allegroserve.txt. ;; ;; This code 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 ;; Lesser General Public License for more details. ;; ;; Version 2.1 of the GNU Lesser General Public License is in the file ;; license-lgpl.txt that was distributed with this file. ;; If it is not present, you can access it from ;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; ;; $Id: decode.cl,v 1.10 2005-02-20 12:20:45 rudi Exp $ ;; Description: ;; decode/encode code ;;- This code in this file obeys the Lisp Coding Standard found in ;;- http://www.franz.com/~jkf/coding_standards.html ;;- (in-package :net.aserve) ;---------------- urlencoding ---------------- ; there are two similar yet distinct encodings for character strings ; that are referred to as "url encodings". We'll refer to ; the first as uriencoding and the second as form-urlencoding ; ; 1. uri's. rfc2396 describes the format of uri's ; uris use only the printing characters. ; a url can be broken down into a set of a components using ; a regular expression matcher. ; Each component consists of a string of characters. Certain ; characters must be escaped with %xy in order to put them ; in the uri, and others need only be escaped in certain components ; where not escaping them would change the meaning. It's legal ; to over-escape though. ; Here are the characters that need never be escaped: ; lower case a-z ; upper case A-Z ; numbers 0-9 ; mark chars: - _ . ! ~ * ' ( ) ; ; anything else should be escaped. ; ; The encoding (converting characters to their %xy form) must be ; done on a component by component basis for a uri. ; You can't just give a function a complete uri and say "encode this" ; because if it's a uri then it's already encoded. You can ; give a function a filename to be put into a uri and ; say "encode this" and that function ; could look for reserved characters in the filename and convert them ; to %xy form. ; ; 2. x-www-form-urlencoded ; when the result of a form is to be sent to the web server ; it can be sent in one of two ways: ; 1. the "get" method where the form data is passed in the uri ; after a "?". ; 2 the "post" method where the data is stored in the body ; of the post with an application/x-www-form-urlencoded ; mime type. ; ; the form data is sent in this format ; name=value&name2=value2&name3=value3 ; where each of the name,value items is is encoded ; such that ; alphanumerics are unchanged ; space turns into "+" ; linefeed turns into "%0d%0a" ; The following characters don't have to be encoded: ; - _ . ! ~ * ' ( ) ; Everything else must be escaped. While the escaping ; isn't necessary to be stored as the body of a post form ; we want to use the same function to encode queries ; to be placed in uris, and there escaping is more necessary. ;--- uriencoding (defvar *uri-encode* ;; maps 7 bit characters to t iff they have to be encoded ;; all characters with the 8th bit set must be encoded (let ((res (make-array 128 :initial-element t))) ; the alphanums (dolist (range '((#\a #\z) (#\A #\Z) (#\0 #\9))) (do ((i (char-code (car range)) (1+ i))) ((> i (char-code (cadr range)))) (setf (svref res i) nil))) ; the mark characters: (dolist (ch '(#\- #\_ #\. #\! #\~ #\* #\' #\( #\))) (setf (svref res (char-code ch)) nil)) res)) (defun uri-encode-p (code) ;; return t iff the character must be encoded as %xy in a uri (if* (>= code 128) then t else (svref *uri-encode* code))) #+allegro (defun uriencode-string (str &key (external-format *default-aserve-external-format*)) ;; encode the given string using uri encoding. ;; It may return the same string if no encoding need be done ;; (let ((len (native-string-sizeof str :external-format external-format)) (count 0)) (excl::with-dynamic-extent-usb8-array (mbvec len) ;; We use string-to-mb for 5.0.1 compatibility. string-to-octets is ;; generally prefered after 6.0. (string-to-mb str :external-format external-format :null-terminate nil :mb-vector mbvec) ;; count the number of encodings that must be done (dotimes (i len) (if* (uri-encode-p (aref mbvec i)) then (incf count))) (if* (zerop count) then str ;; just return the string, no encoding done else (excl::with-dynamic-extent-usb8-array (newmbvec (+ len (* 2 count))) (let ((j 0)) (dotimes (i len) (let ((code (aref mbvec i))) (if* (uri-encode-p code) then (setf (aref newmbvec j) #.(char-code #\%)) (macrolet ((hexdig (code) ;; return char code of hex digit `(if* (< ,code 10) then (+ ,code #.(char-code #\0)) else (+ (- ,code 10) #.(char-code #\a))))) (let* ((upcode (logand #xf (ash code -4))) (downcode (logand #xf code))) (setf (aref newmbvec (+ j 1)) (hexdig upcode)) (setf (aref newmbvec (+ j 2)) (hexdig downcode)))) (incf j 3) else (setf (aref newmbvec j) code) (incf j))))) (values ;; use values to suppress multiple values returned by ;; octets-to-string. ;; We use mb-to-string for 5.0.1 compatibility. ;; octets-to-string is generally prefered after 6.0. (mb-to-string newmbvec :external-format :latin1-base :end (+ len (* 2 count))))))))) #-allegro (defun uriencode-string (str &key (external-format *default-aserve-external-format*)) ;; encode the given string using uri encoding. ;; It may return the same string if no encoding need be done ;; (declare (ignore external-format)) (let ((len (length str)) (count 0)) (let ((byte-string (loop :with result = (make-array len :element-type '(unsigned-byte 8)) :for i :from 0 :below len :do (setf (aref result i) (char-code (aref str i))) :finally (return result)))) ;; count the number of encodings that must be done (dotimes (i len) (if* (uri-encode-p (aref byte-string i)) then (incf count))) (if (zerop count) str ;; just return the string, no encoding done (let* ((newstr (make-string (+ len (* 2 count)))) (j 0)) (dotimes (i len) (let ((code (aref byte-string i))) (if (uri-encode-p code) (progn (setf (aref newstr j) #\%) (macrolet ((hexdig (code) ;; return char code of hex digit `(if* (< ,code 10) then (code-char (+ ,code #.(char-code #\0))) else (code-char(+ (- ,code 10) #.(char-code #\a)))))) (let* ((upcode (logand #xf (ash code -4))) (downcode (logand #xf code))) (setf (aref newstr (+ j 1)) (hexdig upcode)) (setf (aref newstr (+ j 2)) (hexdig downcode)))) (incf j 3)) (progn (setf (aref newstr j) (code-char code)) (incf j))))) newstr))))) (defun uridecode-string (str &key (external-format *default-aserve-external-format*)) ;; decoded the uriencoded string, returning possibly the ;; same string ;; (un-hex-escape str nil :external-format external-format) ) ;---- form-urlencoding (defvar *url-form-encode* ;; maps 7 bit characters to t iff they have to be encoded ;; all characters with the 8th bit set must be encoded ;; ;; what's stored in the table is ;; nil - no encoding needed ;; N (integer) - how many extra characters are needed to encode this ;; (i.e. one less than the total size encoded) (let ((res (make-array 128 :initial-element 2) ; assume all escaped )) ; don't escape the alphanumerics (dolist (range '((#\a #\z) (#\A #\Z) (#\0 #\9))) (do ((i (char-code (car range)) (1+ i))) ((> i (char-code (cadr range)))) (setf (svref res i) nil))) ; these 'mark' characters don't need escaping either (dolist (ch '(#\- #\_ #\. #\! #\~ #\* #\' #\( #\))) (setf (svref res (char-code ch)) nil)) ; note: character needing special handling are space and linefeed (setf (svref res #.(char-code #\space)) 0) (setf (svref res #.(char-code #\linefeed)) 5) res)) (defun query-to-form-urlencoded (query &key (external-format *default-aserve-external-format*)) ;; query is a list of conses, each of which has as its ;; car the query name and as its cdr the value. A value of ;; nil means we encode name= and nothing else ;; encode into single string (let (res) (dolist (ent query) (if* res then (push "&" res) ; separator ) (push (encode-form-urlencoded (car ent) :external-format external-format) res) (push "=" res) (if* (cdr ent) then (push (encode-form-urlencoded (cdr ent) :external-format external-format) res))) (apply #'concatenate 'string (nreverse res)))) (defmacro with-tohex-cvt-buffer ((buffer-var str) &body body) #-(and allegro (version>= 6 0)) ;; Not using a separate buffer `(let ((,buffer-var ,str)) (macrolet ((buf-elt (buf i) `(char-code (char ,buf ,i)))) ,@body)) #+(and allegro (version>= 6 0)) `(let ((,buffer-var (string-to-octets ,str :external-format external-format :null-terminate nil))) (macrolet ((buf-elt (buf i) `(aref ,buf ,i))) ,@body))) (defun encode-form-urlencoded (str &key (external-format *default-aserve-external-format*)) ;; encode the given string using form-urlencoding ;; a x-www-form-urlencoded string consists of a sequence ;; of name=value items separated by &'s. ;; Each of the names and values is separately encoded using this function. ;; to build a complete x-www-form-urlencoded string use ;; query-to-form-urlencoded. ; first compute if encoding has to be done and what it will ; cost in space (declare (ignorable external-format)) (if* (not (stringp str)) then (setq str (format nil "~a" str))) (with-tohex-cvt-buffer (buf str) (let (extra) (dotimes (i (length buf)) (let ((code (buf-elt buf i))) (let ((this-extra (if* (< code 128) then (svref *url-form-encode* code) else 2 ; encode as %xy ))) (if* this-extra then (setq extra (+ (or extra 0) this-extra)))))) (if* (null extra) then ; great, no encoding necessary str else ; we have to encode (let ((ret (make-string (+ (length buf) extra)))) (do ((from 0 (1+ from)) (end (length buf)) (to 0)) ((>= from end)) (let* ((code (buf-elt buf from))) (if* (eq code #.(char-code #\space)) then ; space -> + (setf (schar ret to) #\+) (incf to) elseif (eq code #.(char-code #\linefeed)) then (dolist (nch '(#\% #\0 #\d #\% #\0 #\a)) (setf (schar ret to) nch) (incf to)) elseif (or (>= code 128) (svref *url-form-encode* code)) then ; char -> %xx (macrolet ((hex-digit-char (num) ; number to hex char `(let ((xnum ,num)) (if* (> xnum 9) then (code-char (+ #.(char-code #\a) (- xnum 10))) else (code-char (+ #.(char-code #\0) xnum)))))) (setf (schar ret to) #\%) (setf (schar ret (+ to 1)) (hex-digit-char (logand #xf (ash code -4)))) (setf (schar ret (+ to 2)) (hex-digit-char (logand #xf code)))) (incf to 3) else ; normal char (setf (schar ret to) (code-char code)) (incf to)))) ret))))) (defun form-urlencoded-to-query (str &key (external-format *default-aserve-external-format*)) ;; decode the x-www-form-urlencoded string returning a list ;; of conses, the car being the name and the cdr the value, for ;; each form element. This list is called a query list. ;; (if* (not (typep str 'simple-array)) then ; we need it to be a simple array for the code below to work (setq str (copy-seq str))) (let ((res nil) (max (length str))) (do ((i 0) (start 0) (name) (max-minus-1 (1- max)) (seenpct) ;; The following is a flag which determines whether we should do ;; external-format processing on the source string. ;; Note that we are assuming the source string not to be in Unicode, ;; but to contain one latin1 octet per element. This is the way ;; a uri gets returned by parse-uri. (seen-non-ascii nil) (ch)) ((>= i max)) (setq ch (schar str i)) (let (obj) (if* (or (eq ch #\=) (eq ch #\&)) then (setq obj (buffer-substr str start i)) (setq start (1+ i)) elseif (eql i max-minus-1) then (setq obj (buffer-substr str start (1+ i))) elseif (and (not seenpct) (or (eq ch #\%) (eq ch #\+))) then (setq seenpct t) elseif (and (not seen-non-ascii) (>= (char-code ch) #.(expt 2 7))) then (setq seen-non-ascii t)) (if* obj then (if* (or seenpct seen-non-ascii) then (setq obj (un-hex-escape obj t :external-format external-format) seenpct nil)) (if* name then (push (cons name obj) res) (setq name nil) elseif (or (eq ch #\&) (eq i max-minus-1)) then ; a name with no value (push (cons obj "") res) else ; assert (eq ch #\=) (setq name obj)))) (incf i)) (nreverse res))) (defmacro with-unhex-cvt-buffer ((buffer-var size) &body body) #-(and allegro (version>= 6 0)) ;; Buffer is a string, which gets returned `(let ((,buffer-var (make-string ,size))) (macrolet ((cvt-buf-to-string (x &key external-format end) (declare (ignore external-format end)) x) (set-buf-elt (buf i char) `(setf (schar ,buf ,i) ,char)) (buf-elt (buf i) `(schar ,buf ,i))) ,@body)) #+(and allegro (version>= 6 0)) ;; Buffer is a static octet array, which gets converted to a string. `(excl::with-dynamic-extent-usb8-array (,buffer-var ,size) (macrolet ((cvt-buf-to-string (x &key external-format end) `(values (octets-to-string ,x :end ,end :external-format ,external-format))) (set-buf-elt (buf i char) `(setf (aref ,buf ,i) (char-code ,char))) (buf-elt (buf i) `(code-char (aref ,buf ,i)))) ,@body))) (defun un-hex-escape (given spacep &key (external-format *default-aserve-external-format*)) ;; convert a string with %xx hex escapes into a string without ;; if spacep it true then also convert +'s to spaces ;; (declare (ignorable external-format)) (let ((count 0) (seenplus nil) ;; The following is a flag which determines whether we should do ;; external-format processing on the source string. ;; Note that we are assuming the source string not to be in Unicode, ;; but to contain one latin1 octet per element. This is the way ;; a uri gets returned by parse-uri. (seen-non-ascii nil) (len (length given))) ; compute the number of %'s (times 2) (do ((i 0 (1+ i))) ((>= i len)) (let ((ch (schar given i))) (if* (eq ch #\%) then ; check for %0a%0d which is to be converted to #\linefeed (if* (and (< (+ i 5) len) ; enough chars left (do ((xi (+ i 1) (+ xi 1)) (end (+ i 6)) (pattern '(#\0 #\d #\% #\0 #\a) (cdr pattern))) ((>= xi end) t) (if* (not (char-equal (schar given xi) (car pattern))) then (return nil)))) then ; we are looking at crlf, turn into ; lindfeed (incf count 5) ; 5 char shrinkage (incf i 5) else (incf count 2) (incf i 2)) elseif (eq ch #\+) then (setq seenplus t) elseif (>= (char-code ch) #.(expt 2 7)) then (setq seen-non-ascii t)))) (if* (and (null seenplus) (null seen-non-ascii) (eq 0 count)) then ; move along, nothing to do here (return-from un-hex-escape given)) (macrolet ((cvt-ch (ch) ;; convert hex character to numeric equiv `(let ((mych (char-code ,ch))) (if* (<= mych #.(char-code #\9)) then (- mych #.(char-code #\0)) else (+ 9 (logand mych 7)))))) (with-unhex-cvt-buffer (str (- len count)) (do ((to 0 (1+ to)) (from 0 (1+ from))) ((>= from len) (cvt-buf-to-string str :end to :external-format external-format)) (let ((ch (schar given from))) (if* (eq ch #\%) then (let ((newchar (code-char (+ (ash (cvt-ch (schar given (1+ from))) 4) (cvt-ch (schar given (+ 2 from))))))) (if* (and (eq newchar #\linefeed) (> to 0) (eq (buf-elt str (1- to)) #\return)) then ; replace return by linefeed (decf to)) (set-buf-elt str to newchar)) (incf from 2) elseif (and spacep (eq ch #\+)) then (set-buf-elt str to #\space) else (set-buf-elt str to ch)))))))) ;----------------- base64 -------------------- ;;;; encoding algorithm: ;; each character is an 8 bit value. ;; three 8 bit values (24 bits) are turned into four 6-bit values (0-63) ;; which are then encoded as characters using the following mapping. ;; Zero values are added to the end of the string in order to get ;; a size divisible by 3 (these 0 values are represented by the = character ;; so that the resulting characters will be discarded on decode) ;; ;; encoding ;; 0-25 A-Z ;; 26-51 a-z ;; 52-61 0-9 ;; 62 + ;; 63 / ;; (defvar *base64-decode* ;; ;; use in decoding to map characters to values ;; (let ((arr (make-array 128 :element-type '(unsigned-byte 8) :initial-element 0))) (do ((i 0 (1+ i)) (ch (char-code #\A) (1+ ch))) ((> ch #.(char-code #\Z))) (setf (aref arr ch) i)) (do ((i 26 (1+ i)) (ch (char-code #\a) (1+ ch))) ((> ch #.(char-code #\z))) (setf (aref arr ch) i)) (do ((i 52 (1+ i)) (ch (char-code #\0) (1+ ch))) ((> ch #.(char-code #\9))) (setf (aref arr ch) i)) (setf (aref arr (char-code #\+)) 62) (setf (aref arr (char-code #\/)) 63) arr)) (defvar *base64-encode* ;; ;; used in encoding to map 6-bit values to characters ;; (let ((arr (make-array 64 :element-type 'character))) (dotimes (i 26) (setf (schar arr i) (code-char (+ (char-code #\A) i)))) (dotimes (i 26) (setf (schar arr (+ 26 i)) (code-char (+ (char-code #\a) i)))) (dotimes (i 10) (setf (schar arr (+ 52 i)) (code-char (+ (char-code #\0) i)))) (setf (schar arr 62) #\+) (setf (schar arr 63) #\/) arr)) ;; note: 12/5/03 ;; beginning in acl 6.2 patch excl.003 there are more efficient built-in ;; functions for doing this conversion: ;; excl:string-to-base64-string [encode] ;; excl:base64-string-to-string [decode] ;; ;; At some future point we'll make use of these functions in AllegroServe ;; and drop the functions below. ;; (defun base64-decode (string) ;; ;; given a base64 string, return it decoded. ;; beware: the result will not be a simple string ;; (let ((res (make-array (length string) :element-type 'character :fill-pointer 0 :adjustable t)) (arr *base64-decode*)) (declare (type (simple-array (unsigned-byte 8) (128)) arr)) (do ((i 0 (+ i 4)) (cha) (chb)) ((>= i (length string))) ; for multiline decoding, ignore cr and lfs (loop (let ((ch (char string i))) (if* (or (eq ch #\linefeed) (eq ch #\return)) then (incf i) (if* (>= i (length string)) then (return-from base64-decode res)) else (return)))) (let ((val (+ (ash (aref arr (char-code (char string i))) 18) (ash (aref arr (char-code (char string (+ i 1)))) 12) (ash (aref arr (char-code (setq cha (char string (+ i 2))))) 6) (aref arr (char-code (setq chb (char string (+ i 3)))))))) (vector-push-extend (code-char (ash val -16)) res) ;; when the original size wasn't a mult of 3 there may be ;; non-characters left over (if* (not (eq cha #\=)) then (vector-push-extend (code-char (logand #xff (ash val -8))) res)) (if* (not (eq chb #\=)) then (vector-push-extend (code-char (logand #xff val)) res)))) res)) (defun base64-encode (str) ;; ;; take the given string and encode as a base64 string ;; beware: the result will not be a simple string ;; (let ((output (make-array (ceiling (* 1.3 (length str))) :element-type 'character :fill-pointer 0 :adjustable t)) v1 v2 v3 eol (from 0) (max (length str)) ) (loop (if* (>= from max) then (return)) (setq v1 (char-code (schar str from))) (incf from) (if* (>= from max) then (setq v2 0 eol t) else (setq v2 (char-code (schar str from)))) (incf from) ; put out first char of encoding (vector-push-extend (schar *base64-encode* (logand #x3f (ash v1 -2))) output) ; put out second char of encoding (vector-push-extend (schar *base64-encode* (+ (ash (logand 3 v1) 4) (logand #xf (ash v2 -4)))) output) (if* eol then ; two pads (vector-push-extend #\= output) (vector-push-extend #\= output) (return)) (if* (>= from max) then (setq v3 0 eol t) else (setq v3 (char-code (schar str from)))) (incf from) ; put out third char of encoding (vector-push-extend (schar *base64-encode* (+ (ash (logand #xf v2) 2) (logand 3 (ash v3 -6)))) output) (if* eol then (vector-push-extend #\= output) (return)) ; put out fourth char of encoding (vector-push-extend (schar *base64-encode* (logand #x3f v3)) output)) output)) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/defsys.cl000066400000000000000000000036771133377100500231450ustar00rootroot00000000000000(in-package "CL-USER") (defsystem "ASERVE" (:default-pathname "ASERVE:") :members ("./htmlgen/htmlgen" "macs" "main" "headers" "parse" "decode" "publish" "authorize" "log" "client" "proxy" ) :rules ((:in-order-to :compile "macs" (:caused-by (:compile "htmlgen")) (:requires (:load "htmlgen"))) (:in-order-to :load "macs" (:requires (:load "htmlgen"))) (:in-order-to :compile "main" (:caused-by (:compile "macs")) (:requires (:load "macs"))) (:in-order-to :load "main" (:requires (:load "macs"))) (:in-order-to :compile "headers" (:caused-by (:compile "main")) (:requires (:load "main"))) (:in-order-to :load "headers" (:requires (:load "main"))) (:in-order-to :compile "parse" (:caused-by (:compile "headers")) (:requires (:load "headers"))) (:in-order-to :load "parse" (:requires (:load "headers"))) (:in-order-to :compile "decode" (:caused-by (:compile "parse")) (:requires (:load "parse"))) (:in-order-to :load "decode" (:requires (:load "parse"))) (:in-order-to :compile "publish" (:caused-by (:compile "decode")) (:requires (:load "decode"))) (:in-order-to :load "publish" (:requires (:load "decode"))) (:in-order-to :compile "authorize" (:caused-by (:compile "publish")) (:requires (:load "publish"))) (:in-order-to :load "authorize" (:requires (:load "publish"))) (:in-order-to :compile "log" (:caused-by (:compile "authorize")) (:requires (:load "authorize"))) (:in-order-to :load "log" (:requires (:load "authorize"))) (:in-order-to :compile "client" (:caused-by (:compile "log")) (:requires (:load "log"))) (:in-order-to :load "client" (:requires (:load "log"))) (:in-order-to :compile "proxy" (:caused-by (:compile "client")) (:requires (:load "client"))) (:in-order-to :load "proxy" (:requires (:load "client")))))cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/doc/000077500000000000000000000000001133377100500220605ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/doc/aserve.html000077500000000000000000005235131133377100500242470ustar00rootroot00000000000000 AllegroServe

AllegroServe - A Web Application Server
version 1.2.32

copyright(c) 2000-2003. Franz Inc

Table of Contents

Introduction
Running AllegroServe
Starting the Server
  start
Shutting Down the Server
  shutdown
Publishing Information
  publish-file
    Entity hook function
  publish-directory
     Directory Access Files
  publish
     publish-prefix
     publish-multi
Generating a Computed Response
  with-http-response
  with-http-body
  get-request-body
  header-slot-value
  reply-header-slot-value
  request-query
     request-query-value
Request Object Readers and Accessors
  request-method
  request-uri
  request-protocol
  request-socket
  request-wserver
  request-raw-request
  request-reply-code
  request-reply-date
  request-reply-headers
  request-reply-content-length
  request-reply-plist
  request-reply-strategy
  request-reply-stream
CGI Program Execution
  run-cgi-program
Form Processing
  get-multipart-header
  parse-multipart-header
  get-multipart-sequence
     get-all-multipart-data
     form-urlencoded-to-query
  query-to-form-urlencoded
Authorization
  get-basic-authorization
  set-basic-authorization
  password-authorizer
  location-authorizer
     function-authorizer
Cookies
  set-cookie-header
  get-cookie-values
Variables
     *aserve-version*
  *default-aserve-external-format*
  *http-response-timeout*
  *mime-types*
AllegroServe Request Processing Protocol
  handle-request
  standard-locator
  unpublish-locator
  authorize
  failed-request
  denied-request
  process-entity
Client Functions
  do-http-request
  client-request
  cookie-jar
  make-http-client-request
  read-client-response-headers
  client-request-read-sequence
  client-request-close
  uriencode-string
Proxy
Cache
Request Filters
Virtual Hosts
Timeouts
  wserver-io-timeout
  wserver-response-timeout
Miscellaneous
     ensure-stream-lock
     map-entities
Running AllegroServe as a Service on Windows NT
Using International Characters in AllegroServe
Debugging
     net.aserve::debug-on
  net.aserve::debug-off


Introduction

AllegroServe is a webserver  written at Franz Inc.  AllegroServe is designed to work with the htmlgen system for generating dynamic html, as one of the big advantages of  a web server written in Common Lisp is the ability to generate html dynamically.  In this document we'll consider the web server and dynamic html generation to be parts of the same product.

The design goals of AllegroServe are:

  • a very small footprint.   It should be possible to make AllegroServe a part of every application without being concerned about the impact of its size and processing requirements.
  • simple configuration.  AllegroServe should start automatically with minimal input from the user. 
  • easy to use.   The typical scenarios should be easy to program with just knowledge of simple html.
  • usable in commercial applications .
  • support the latest http protocol (currently HTTP/1.1)
  • runnable in multiple configurations.    We want to support a program that just wants to make some part of it visible or configurable by one user through a web server.  We also want to support  a web site running on a multiprocessor taking many hits per second.   Finally, we want to support levels in between those scenarios.

 

Running AllegroServe

Running  AllegroServe requires that you

  • load aserve.fasl into Lisp
  • publish zero or more urls
  • start the server
  • publish zero or more urls

We mention publish twice to emphasize that you can publish urls before and after you start the server.

 

Starting the server

The function net.aserve:start is used to start the server running.

(start &key port host listeners chunking keep-alive server setuid setgid
            debug proxy proxy-proxy cache restore-cache accept-hook ssl ssl-password
            os-processes external-format)

If no arguments are given then start  starts a multi-threaded web server on port 80, which is the standard web server port.    If you are running this on Unix then you can only allocate port 80 if you are logged in as root or have made Lisp a set-user-id root program.

There are quite a few keyword arguments to start, but in practice you only need be concerned with :port and :listeners.     The arguments have the following meanings:

  • port -- the port on which to open the web server.  80 is the default.
  • host -- the host on which to run the server.  If you don't specify this then the server will listen on all TCP/IP network interfaces on the machine.   If you specify "localhost" then the server willl only accept connections from the same machine.   Other values for host can be used to run AllegroServe only a particular network interface.  Host can be a name (like "foo.franz.com"), a dotted ip address "192.168.0.1" or an integer IP address.
  • listeners -- the number of threads to process http requests.     If a value isn't given for the :listeners argument then 5 is assumed.   If  the value is nil or 0 then the server runs in simple server mode in which the start function doesn't return - instead it processes the requests itself, one at a time.  If a positive number is given as the value of :listeners then the server runs in threaded server mode.   In this mode separate lisp lightweight processes are started to handle requests from clients, the number of request handing threads is equal to the value of the :listeners keyword argument.  In this mode the start function returns after starting the other threads.
  • chunking -- if true then the server will use the chunked transfer encoding when it's possible to do so.  This is an optimization and should be left enabled unless you suspect that it is the cause of some sort of error.   The default is true.
  • keep-alive -- if true then the server will keep connections alive if requested by the web client, and if there are sufficient free threads to handle new requests coming in.    This is an optimization and should be left on.   The default is true.
  • server -- if this is a passed a value it must be a wserver object, which denotes  a particular instance of a web server.   This is for support of running multiple independent web servers in the same lisp image.  This will be described in a later section (eventually).
  • setuid -- after opening the port, change the user id of this process to the given number (only numbers are allowed, not names).  This will only have an effect on Unix and it will only succeed if the current user id is root.   You would want to use this argument if you plan on opening port 80 on Unix, as you would have to start the server as root but then would want to change the user id to an account with fewer privileges before allowing possibly malicious people to connect to it.
  • setgid -- after opening the port, change the group  id of this process to the given number (only numbers are allowed, not names).  This will only have an effect on Unix
  • debug -- if given a number this will print debugging messages whose associated codes are this number or less.    This is really an internal switch and may be removed in future versions.
  • proxy -- if true then this server will also act as a proxy server and will forward http requests to other servers.
  • proxy-proxy -- if proxy is also given a true value, then this argument determines where the proxy will forward  requests.  If proxy-proxy is nil then the requests go directly to the server given in the request.  If proxy-proxy is given  a value of a host and an optional port then the request is forwarded to the proxy server at that address.   Valid values for proxy-proxy look like "proxy.myfirm.com" and "localhost:8000".   If no port is not specified, port 80 is assumed.
  • cache -- if true (and if proxy is true as well) cache locally the work done by the proxy server.  The value of this variable specifies the size of the caches, both memory and disk.  See the section on caches for more details on the format of the argument.
  • restore-cache - if given a value then this value should be the name of the file created by net.aserve:shutdown when given the save-cache argument.   The state of the cache is restored as of when it was saved.    This will only succeed if the external cache files that were in use when the shutdown was done are in exactly the same state they were when the shutdown was done.   When the restore-cache argument is given, the value of the cache argument is ignored.
  • accept-hook -- this should be a function of one argument, the socket which was created when a http request was accepted by AllegroServe.  The function should return a socket for AllegroServe to use.  This hook is normally used to turn a regular socket into an SSL socket.
  • ssl - if true then it should be the name of PEM encoded file containing the server certificate and the associated private key.  This causes the server to listen for SSL connections only.  The default value of port is made 443 (rather than 80).  This makes use of the accept-hook argument so if ssl is specified then accept-hook should not be specified.   ssl is supported only in certain versions of Allegro CL.
  • ssl-password - if the private key in the PEM encoded file referenced by the ssl argument is encrypted, then this is the key to decrypt it.
  • os-processes - if given it should be an integer number of operating system processes in which to run AllegroServe.  This is available on Unix only at the moment.  The AllegroServes in different processes do not share a common Lisp heap..  
  • external-format - If given it should name the value to which *default-aserve-external-format* should be bound to when requests are processed.  The default value is :latin1-base

 

Shutting down the server

(shutdown &key server save-cache)

This shuts down the web server given (or the most recently started web server if no argument is passed for server).  If save-cache is given then it should be the name of a file to which the current state of the proxy cache will be written.   The save-cache file will only contain in-memory information about the cache.  The cache usually consists of disk files as well and in order to maintain the complete state of the cache these files must be saved by the user as well.  The information in the save-cache file refers to the disk cache files so those disk cache files must exist and be in the same state and location should the user choose to restore the state of the cache.

 

Publishing information

Once the server is started it will accept requests from http clients, typically web browsers.   Each request is parsed and then AllegroServe searches for an object to handle that request.   That object is called an entity.  If an entity is found, it is passed the request and is responsible for generating and sending a response to the client.  If an entity can't be found then AllegroServe sends back a response saying that that request was invalid.

Publishing is the process of creating entities and registering them in the tables scanned by AllegroServe after a request is read.

Components of a request

A request from an http client contains a lot of information.  The two items that determine which entity will handle the request are

  • the path of the url.  This is the part of the url after the host name and before the query string (if any).  For example in the url  http://bar.com:8030/files/foo?xx=3&yy=4 the part we call the path  is just /files/foo.
    If     the path contains escaped characters (e.g. /foo%20bar) then we replace the %xx in the path with the actual character before processing the request.  Thus if you're publishing an entity to handle a uri such as http://www.machine.com/foo%20bar you should publish the path "foo bar" and not "foo%20bar".
  • the host to which the request is directed.   This is not necessarily the host that is receiving the request due to virtual hosts and proxy servers.  This value comes from the Host: header line, if one is given. 

 

 

A request contains other information and while that information isn't used to determine which entity will handle the request it can be used by the entity handling the request in any way it sees fit.

 

The following functions create entities and specify which requests they will handle.    An entity is distinguished by the path and host values passed to the particular publish function.   When a publish is done for a path and host for which there is already an entity assigned, the old entity is replaced by the new entity.

 

(publish-file &key path host port  file content-type class preload cache-p remove
                   authorizer server timeout plist hook)

This creates an entity that will return the contents of a file on the disk in response to a request.   The url and file  must be given, the rest of the arguments are optional..  The arguments have these meanings:

  • path -- a string that must match the name part of the url as described above in Components of a Request
  • host -- normally nil.  If you wish to do virtual hosting read this section describing how it's done.a
  • port -- this argument is currently unused and will likely be removed in future versions.
  • file -- the name of the file to return when a request to this entity is made.   The file doesn't have to exist until the request is made unless preload is specified as true.
  • content-type -- A string describing the content of the file.  This is often referred to as the MIME type of the file.  An example is "text/html" to describe an html file.  If a content-type value is not provided, then AllegroServe checks the pathname-type in the  *mime-types* hash table to see if there is a content-type associated with this pathname-type.  If it fails to find a content-type then it uses the type "application/octet-stream". 
  • class -- a Clos class name or class object to be used to hold this entity.  The class must be a subclass of  file-entity.   
  • preload --if true it instructs AllegroServe to read the contents of the file in immediately and store it in a lisp object.  This will speed up the response to this request.  If the file on disk is updated AllegroServe will ignore the preloaded content and will access the content from disk.   If preload is true then you most likely want to specify cache-p true as well.
  • cache-p -- if true then AllegroServe will cache the last value read for this file.  When asked for this file AllegroServe will check to see if the file has changed on disk (using the last modified time as a measure).  If the file hasn't changed AllegroServe will returned the cached value, otherwise AllegroServe will read in and cache the new contents of the file and will return that as a response.
  • remove -- instead of adding an entity, remove the entities that match the given path and host. This removes all entities, not just file entities.  If a host value is not passed in an argument, then this will remove all entities for this path, regardless of their host values.
  • server -- if this entity should only be served by a particular server, then this specifies which server.   See the section (to be written) on running multiple servers in the same Lisp process.
  • timeout - specifies the number of seconds AllegroServe has to return this file to the http client.  If AllegroServe is running in a lisp that supports timeouts on each I/O operation (e.g. Acl 6.1 or newer) then the default value for this argument is a huge number, meaning in effect that there will be no time limit on the transfer.   If I/O timeouts are not supported then the default value of this argument is nil meaning ignore this value and use the timeout value held in the server object and retrieved with wserver-response-timeout..
  • plist - initial property list for this entity
  • hook - a function of three arguments: req,ent and extra.    See entity hook function.

The function that handles requests for files will respond correctly to If-Modified-Since header lines and thus minimizes network traffic.

Example:

This will work on Unix where the password file is stored in /etc.

(publish-file :path "/password" :file "/etc/passwd" :content-type "text/plain")

Entity Hook Function

AllegroServe supplies many subclasses of entity which automatically generate a responses to requests.     There are times when user code needs to run during the generation of  a response by one of the built-in entity classes.    For example you may wish to add or modify the headers that will be sent back with the publish-file's response.    The entity hook function is called just before the with-http-body in the response function.  At this point all the response headers have been specified but the hook function is free to change them or add new headers.

The entity hook function takes three arguments: req, ent and extra.   Req and ent are the familiar http-request and entity arguments.   Extra is usually nil but will be one of the following symbols to tell  the hook function if it's being called in a special context.

:illegal-range request has asked for a range of bytes that is not present in the entity.   As a result a "416 - Illegal Range Specified"  response is being generated.
:in-range request has asked for a range of bytes and that range is being returned.
:not-modified request contains an "If Not Modified" header and AllegroServe is returning a "304 - Not Modified" response.

 

 

(publish-directory &key prefix host port destination remove authorizer server
                        indexes filter timeout plist publisher access-file
                        hook)

publish-directory is used to publish a complete directory tree of files.  This is similar to how web servers such as Apache publish files.   AllegroServe publishes the files in  the directory tree in a lazy manner.   As files in the tree are referenced by client requests entities are created and published. 

publish-directory creates a mapping from all urls whose name begins with prefix to files stored in the directory specified by the destination.   The host, port, remove, authorizer, plist, hook and server arguments are as described above for publish-file.      The timeout argument defaults as described in publish-file.  The hook argument specifies what hook function should be put in the entities that publish-directory creates.   The access-file argument names the access file name which will be used in this directory tree. When a request comes in for which there isn't an entity that matches it exactly,  AllegroServe checks to see if a prefix of the request has been registered.  If so, and if the resulting entity is a directory-entity as created by this function, then it strips the prefix off the given request and appends the remaining part of the request to the destination string.  It then publishes that (normally using publish-file and computing the content-type from the file type).    Next that file-entity is made to handle the request in the normal manner.

If a request comes that maps to a directory rather than a file then AllegroServe tries to locate an index file for that directory.  The indexes argument specifies a list of index files to search for.  By default the list consists of two filenames "index.html" and "index.htm".

The valueof the filter argument is a function of four values: req ent  filename and info.  req and ent are the request and entity objects that describe the current client request.     filename is the name of a known file on the current machine which  is being requested by the current request.  info is the list of access information for this file.

If the filter returns nil then the normal operation  is done by the directory-entity handler: the selected file is published and then the request to access it processed (and subsequent access using that url will just return the file and never go through the filter again).

If the filter chooses to handle the request for the file itself  it must generate a response to the request and then return a non-nil value.  To avoid subsequent calls to the filter for this file the filter may choose to publish a handler for this url.   If the filter wants to forbid access to this file a handy way to to call (failed-request req) and the standard "404 Not found" will be sent back to the client.

The publisher argument can be used to specify exactly what happens when a request comes that's handled by the directory-entity and a file is located on the disk that matches the incoming url.   Nomally a publish-file is done to add that file.  You may want to publish some other kind of entity to represent that file.  The publisher argument, if non-nil, must be a function of  four arguments:  req ent filename info.  The filename is a string naming the file that's been matched with the request.   info is the list of access information for this file.  The publisher function must return an entity to be processed to send back a response.   The publisher function may wish to publish that entity but it need not do so.

Note:  publish-directory is a more general function than its name implies.    It looks at each url path for a match for prefix and if such a match is found the prefix is removed and replaced with destination.   Thus is prefix is "/foo" and destination is "/bar" then a url path of  "/foobaz/joe.html" would be converted to "/barbaz/joe.html".     This is rarely useful but it does show that you have to be careful about the prefix and destination strings.  It's usually the case that if the prefix string ends in "/" then the destination string should end in "/" (and vice versa).  Thus a prefix of "/foo" would have a destination of "/bar" and a prefix of "/foo/" would have a destination of "/bar/". 

 

Directory Access Files

When files are accessed and automatically published you may wish to set some of the parameters of the entity that is published. As mentioned above you can define a publisher function that has complete control in publishing the entity.  A less powerful but easier to use alternative is to place access files in the directory tree being published.   An access file specifies information that you want passed to the publisher function.  You can modify these access files while the directory tree is published and their latest values will be used for publishing subsequent files.    This is similar to they way Apache controls its publishing with .htaccess files (except that in AllegroServe once a file is published the access files have no effect on it).

The name of an access file in AllegroServe is controlled by the :access-file argument to publish-directory.   We'll assume the name chosen is access.cl in this document.   If no :access-file argument is given to publish-directory then no access file checking is done.  When a file is about to be published all access files from the destination directory all the way down to the directory containing the file to be published are read and used.  For example if the destination in a publish-directory was given as "/home/joe/html/" and an http request comes in which references the file "/home/joe/html/pics/archive/foo.jpg"  then AllegroServe will check for access files at all of these locations and in this order

  • /home/joe/html/access.cl
  • /home/joe/html/pics/access.cl
  • /home/joe/html/pics/archive/access.cl

The information is collected as successive access files are read.  The new information is placed before the existing information thus causing subdirectory   access files to possibly shadow information in access files in directories above it.  Also superdirectory access file information is automatically eliminated if it isn't marked as being inherited. 

The publisher function receives the collected information and can do with it what it wishes.  We'll describe what the built-in publisher function does with the information.

When we speak of information in access files we are purposely being vague.   We define what information must look like and what the standard publisher function does with certain information but we allow users to define their own kinds of information and use that in their own publisher function.

Each access file consists of zero or more Lisp forms (and possibly lisp style comments).  Each form is  a list beginning with a keyword symbol and then followed by a property-list-like sequence of   keywords and values.   Nothing in the form is evaluated.     The form cannot contain #. or #,. macros.

One  information form is used by AllegroServe's directory publisher code to decide if it's permitted to descend another directory level:

(:subdirectories  :allow allow-list :deny deny-list :inherit inherit-value)

As AllegroServe descends from the destination directory toward the directory containing the file to be accessed it stops at each directory level accumlates the access information and then tests to see if it can descend further based on the :subdirectories information.   If it cannot descend into the next subdirectory it gives up immediately and a 404 - Not Found response is returned.    See the section Allow Deny processing below for a description of how it uses the :allow and :deny values.

These other information forms are used by the standard publisher function.    Each takes an :inherit argument which defaults to false.   Information not given with ::inherit t will be eliminated as AllegroServe descends directory levels.

name args meaning
:ip :patterns
:inherit		 specifies a location-authorizer restriction on which machines can see published files.  The value of the :patterns argument has the same form as the :patterns slot of a location-authorizer.
:password :realm
:allowed
:inherit		 specifies a password-authorizer restriction on access to published files.   See the password-authorizer documentation for a description of the :realm and :allowed arguments
:files :allow
:deny
:inherit		 specifies which files are visible to be published.  To be visible a file must be allowed and not denied.  What is tested is the filename only (that is the part after the last directory separator in the files's complete name).  See below for the rules on how allow and denied is used.
:mime :types
:inherit		 specifies which mime types are to be associated with which file types.   This list takes precedence over the built-in list inside AllegroServe.  :types is a list of mime specifiers.   A mime specifier is a list beginning with a string giving the mime type followed by the files types that should map to that mime type.   A file type in a list (e.g. ("ReadMe")) refers to the whole file name rather than the type component.

Allow and Deny Processing

The :files and :subdirectories information are used to determine if a file or subdirectory of a given name is accessible.  AllegroServe will collect all the access file information for the directory containing the file or subdirectory and for all directories above it up to the directory given as the destination argument to publish-directory.  Information from superdirectories will only be used :inherit t is given for that information. 

The rules is it that a given name is accessible if it is allowed and not denied.   That is the filename or directory name must match one of the allow clauses and none of the deny clauses.  There may be multiple allow and deny clauses since there may be multiple information forms of the type :files or :subdirectories.    Each allow or deny argument can be a string or a list of strings or nil (which is the same as that argument not being given).   The strings are regular expressions (which are not exactly like unix shell wildcard filename expressions).   In particular ".*" is the regular expression that matches anything.

The special cases are the following

  • if :allow is given as nil or is not given at all then that is the same as specifying ".*" the regular expression that matches everything.
  • if :deny is given as nil or is not given then that is the same as specifying a regular expression that matches nothing.
  • if AllegroServe is looking for :files information and there is none to be found in the accumulated information, then access is allowed.   A similar thing is true if AllegroServe is searching for :subdirectories information and none is found.

 

.

Here is a sample access file:

; only connections to localhost will be able to access the files
(:ip :patterns ((:accept "127.1") :deny) :inherit t)   
(:password :realm "mysite"
           :allowed (("joe" . "mypassword")
                     ("sam" . "secret"))
           :inherit t) ;  applies to subdirectories
; publish html and cgi files, but not those beginning with a period
(:files :allow ("\\.html$" "\\.cgi$") :deny ("^\\."))
; specify mime type for non-standard file extensions.  Also
; specify that a file named exactly ChangeLog should be given
; mime type "text/plain"
(:mime :types (("text/jil" "jil" "jlc") ("text/plain" "cl" ("ChangeLog"))))

 

 

(publish &key path host port content-type function class format remove server authorizer timeout plist hook)

This creates a mapping from a url to a computed-entity, that is an entity that computes its response every time a request comes in.  The path, host, port, remove, server , authorizer, hook and class arguments are as in the other publish functions.  The timeout argument defaults to nil always.   The content-type sets a default value for the response to the request but this can be overridden.  The format argument is either :text (the default) or :binary and it specifies the kind of value that will be sent back (after the response headers, which are always in text).   This value is only important if the response is generated in a particular way (described below).   The value of the hook argument is stored in the entity created however the hook function will only be run if the function supplied makes use of it.

The function argument is  a function of two arguments: an object of class http-request that holds a description of the request, and an object of class entity that holds this entity which is handling the request.   This function must generate a response to the http request, even if the response is only that the request wasn't found.

 

(publish-prefix &key prefix host port content-type function class
                     format remove server authorizer timeout plist hook)

This is like publish except that it declares function to be the handler for all urls that begin with the string prefix.    Note however that prefix handlers have lower priority than exact handlers.   Thus if you declare a prefix handler for "/foo" and also a specific handler for "/foo/bar.html" then the specific handler will be chosen if "/foo/bar.html" is found in an http request.   Typically a prefix handler is used to make available a whole directory of files since their complete names being with a common prefix (namely the directory in which the files are located).    If you want to publish a whole directory then you probably want to use publish-directory since it has a number of features to support file publishing.   The value of the hook argument is stored in the entity created however the hook function will only be run if the function supplied makes use of it.

 

(publish-multi &key path host port content-type items class remove server authorizer timeout hook)

Some web pages are created from information from various sources.   publish-multi allows you to specify a sequence of places that supply data for the combined web page.   The data for each page is cached by publish-multi so that minimal computation is required each time the page is requested.   

The host, port, content-type, class, remove, server, authorizer, hook and timeout arguments are the same as those of the other publish functions.    The items argument is unique to publish-multi and is a list of zero or more of the following objects

  • string or pathname - this is a reference to a file on the server.  This item contributes the contents of the file to the final web page.
  • symbol or function - this is a function of four arguments: req ent cached-time cached-value.   It returns two values:  the new value and the last modified time of the value.   The function may look at the cached-value or cached-time and realize that nothing has changed since that time that would cause this function to return a new value.  In that case it should return the cached-value and cached-time that it received as arguments.   If a value must always be computed each time the function is called it may return nil for the last modified time.  This will result in no LastModified header being sent in the response.    The value the function returns can either be a string or an array of unsigned-byte 8 values.   It's preferred to return an array of unsigned-byte 8 values.  If a string is returned then it will be converted to an array of unsigned-byte 8 by using (string-to-octets string :null-terminate nil).    The cached-value argument to the function will be nil or an unsigned-byte 8 array.
  • (:string string) - this item supplies the given string to the web page.
  • (:binary vector) - vector should be a one dimensional simple-array of (unsigned-byte 8).  This vector of bytes is added to the web page.

Here's an example where we create a page from a fixed header and trailer page with a bit of dynamic content in the middle.

(publish-multi :path "/thetime"
	       :items (list "header.html"
			    #'(lambda (req ent old-time old-val)
				(declare (ignore req ent old-time old-val))
				(with-output-to-string (p)
				  (html-stream p
					       :br
					       "The time is "
					       (:princ (get-universal-time))
					       (:b
						"Lisp Universal Time")
					       :br)))
			    "footer.html"))

Generating a computed response

There are a variety of ways that a response can be sent back to the http client depending on whether keep-alive is being done, chunking is possible, whether the response is text or binary, whether the client already has the most recent data, and whether the size of the body of the response is known before the headers are sent.  AllegroServe handles the complexity of determining the optimal response strategy and the user need only use a few specific macros in the computation of the response in order to take advantage of AllegroServe's strategy computation

Here's a very simple computed response.  It just puts "Hello World!" in the browser window:

(publish :path "/hello"
         :content-type "text/html"
         :function #'(lambda (req ent)
                       (with-http-response (req ent)
                          (with-http-body (req ent)
                             (html "Hello World!")))))

This example works regardless of whether the request comes in from an old HTTP/0.9 browser or a modern HTTP/1.1 browser.  It may or may not send the response back with Chunked transfer encoding and it may or may not keep the connection alive after sending back the response.   The user code doesn't have to deal with those possibilities, it just uses with-http-response and with-http-body and the rest is automatic.  The html macro is part of the htmlgen package that accompanies AllegroServe.   In the case above we are being lazy and not putting out the html directives that should be found on every page of html since most browsers are accommodating.   Here's the function that generates the correct html:

(publish :path "/hello2"
         :content-type "text/html"
         :function #'(lambda (req ent)
                       (with-http-response (req ent)
                         (with-http-body (req ent)
                          (html 
                             (:html
                               (:body "Hello World!")))))))

 

The function above generates: <html><body>Hello World!</body></html>.

 

The macros and functions used in computing responses are these:

(with-http-response (req ent &key timeout check-modified format response content-type)
                    &rest body)

This macro begins the process of generating a response to an http request and then  runs the code in the body which will actually send out the response.  req and ent are the request and entity objects passed into the function designated to compute the response for the request.     timeout sets a time limit for the computation of the response.   If timeout is nil then the entity ent is checked for a timeout value.  If that value is also nil then the timeout value is retreived from the current wserver object using wserver-response-timeout.   If check-modified is true (the default) then the last-modified time stored in the entity object will be compared against the if-modified-since time of the request and if that indicates that the client already has the latest copy of this entity then a not-modified response will be automatically returned to the client and the body of this macro will not be run.   response is an object containing the code and description of the http response we wish to return.    The default value is the value of *response-ok* (which has a code of 200 and a string descriptor "OK").   content-type is a string describing the MIME type of the body (if any) sent after the headers.  It has a form like "text/html".   If content-type isn't given here then the content-type value in the entity (which is set in the call to publish) will be used.

The format argument specifies whether the code that writes the body of the response will want to write :text (e.g. write-char) or :binary (e.g. write-byte) when it writes the data of the body of the response.      Based on the value of the format argument, AllegroServe will create the correct kind of response stream.   If format is not specified here it will default to the value specified when publish was called to create the entity.  If not :format argument was passed to publish then :binary format is assumed.     If :binary is specified then you can write both text and binary to the stream  since Allegro's binary streams also support text calls as well.  If you specify :text then you may end up with a stream that supports only text operations.

An http response consists of a line describing the response code, followed by headers (unless it's the HTTP/0.9 protocol in which case there are no headers),    and then followed by the body (if any) of the response.   with-http-response doesn't normally send anything to the client.  It only does so when it determines that the if-modified-since predicate doesn't hold and that it must send back a not-modified response.    Thus  is not enough to just call with-http-response in your response function.  You must always call with-http-body inside the call to with-http-response.

 

(with-http-body (req ent &key format headers external-format)  &rest body)

This macro causes the whole http response to be sent out.  The macro itself will send out everything except the body of the response.  That is the responsibility of the code supplied as the body form of the macro.     In cases where there is no body to the response being sent it is still necessary to call with-http-body so that the other parts of the response are sent out, e.g. at a minimum you should put (with-http-body (req ent)) in the body of a with-http-response.

The body forms may not be executed! If the request is an http head request then the browser wants only the headers returned.   The with-http-body macro will not evaulate the body forms.   You must be aware of this and should never put code in the body form that absolutely must be executed when a request is given.

The headers argument is a list of conses, where the car is the header name (a keyword symbol) and the cdr is the header value.  These headers are added to the headers sent as part of this response.

Within the body forms the code calls (request-reply-stream req) to obtain a stream to which it can write to supply the body of the response.   The external-format of this stream is set to the value of the external-format argument (which defaults to the value of *default-aserve-external-format*).   The variable *html-stream* is bound to the value of (request-reply-stream req) before the body is evaluated.   This makes it easy  to use the html macro to generate html as part of the response.

Note: there used to be a :format argument to with-http-body. That argument was never used by with-http-body.  The :format argument has been moved to with-http-response so that it can now have an effect on the stream created.

(get-request-body request &key external-format)

Return the body of the request as a string.  If there is no body the return value will be an empty string.   The result is cached inside the request object, so this function can be called more than once while processing a request.   The typical reason for there to be a body to a request is when a web browser sends the result of a form with  a POST method.   The octets that make up the body of the request are converted to a string (and then cached) using the :octets external format as this is the appropriate external format if the request body contains a list of form values.

If an external-format is specified the body is reconverted to a string using the given external-format and then returned from this function.   This reconversion does not affect the cached value.

(header-slot-value request header-name)

Return the value given in the request for the given header-name (a keyword symbol).      If the header wasn't present in this request then nil will be returned.   header-slot-value is a macro that will expand into a fast accessor if the header-name is a constant naming a known header slot

In older versions of aserve the header-name was a string..

 

(reply-header-slot-value request header-name)

Return the value associated with the header header-name in the reply sent back to the client.  This function is setf'able and this is the preferred way to specify headers and values to be sent with a reply.

(request-query request &key uri post external-format)

Decode and return an alist of the query values in the request.   Each item in the alist is a cons where the car is a string giving the name of the argument and the cdr is a string giving the value of the argument.

The query string is in one or both of two places:

  • it begins at the first question mark in the uri and continues until the end of the uri or a sharp sign (#), whichever comes first.
  • it is in the body of a POST request from a web client.

request-query will by default look in both locations for the query string and concatenate the results of decoding both query strings.  If you would like it to not check one or both of the locations you can use the :uri and :post keyword arguments.   If uri is true (and true is the default value) then the query string in the uri is checked.  If post is true (and true is the default value) and if the request is a POST then the body of the post form will be decoded for query values.

The external-format is used in the conversion of bytes in the form to characters.  It defaults to the value of *default-aserve-external-format*.

A query is normally a set of names and values. 
http://foo.com/bar?a=3&b=4 yields a query alist (("a" . "3") ("b" . "4")).
If a name doesn't have an associated value then the value in the alist is the empty string. 
http://foo.com/bar?a&b=&c=4   yields a query alist (("a" . "") ("b" . "") (c . "4"))

.  

(request-query-value key request &key uri post external-format test)

This combines a call to request-query to retrieve the alist of query keys and values, with a call to assoc to search for the specific key, and finally with a call to cdr to return just the value from the assoc list entry.  The test argument is the function to be used to test the given key against the keys in the assoc list. It defaults to #'equal.

If the given key is not present in the query nil is returned.   If the given key is present in the query but doesn't have an associated value then the empty string is returned.

 

Request Object Reader and Accessors

The request object contains information about the http request being processed and it contains information about the response that is being computed and returned to the requestor.   The following functions access slots of the request object.   Those with names beginning with request-reply- are accessing the slots which hold information about the response to the request.   When a function is listed as an accessor that means that it can be setf'ed as well as used to read the slot value.

 

(request-method request) - reader - a keyword symbol naming the kind of request, typically :get, :put or :post.

(request-uri request) - reader - a uri object describing the request.   If the request contains a "Host:" header line then the value of this header is placed in the uri-host and uri-port slots of this uri object.

(request-protocol request) - reader - a keyword symbol naming the http protocol requested.  It is either :http/0.9, :http/1.0 or :http/1.1.

(request-protocol-string request) - reader - a string naming the http protocol requested. It is either "HTTP/0.9", "HTTP/1.0" or "HTTP/1.1".

(request-socket request) - reader - the socket object through which the request was made and to which the response must be sent.    This object can be used to determine the IP address of the requestor.

(request-wserver request) - reader - the wserver object describing the web server taking this request

(request-raw-request request) - reader -  a string holding the exact request made by the client

 

(request-reply-code request)      - accessor - the value describes the response code and string we will return for this request.   See the value of the argument response in with-http-response for more information.

(request-reply-date request)      - accessor - the date the response will be made (in Lisp's universal time format).  This defaults to the time when the request arrived.

(request-reply-headers request) - accessor - an alist of some of the headers to send out with the reply (other headers values are stored in specific slots of the request object).  Each entry in the alist is a cons where the car is a keyword symbol holding the header name and the cdr is the value (it is printed using the ~a format directive).    Typically request-reply-headers isn't used, instead the headers to be sent are passed as the :header argument to with-http-body, or (setf reply-header-slot-value) is called.

(request-reply-content-length request)     - accessor -  the value to send as the Content-Length of this response.   This is computed automatically by AllegroServe and thus a user program shouldn't have to set this slot under normal circumstances.

(request-reply-plist request)      - accessor -  this slot holds a property list on which AllegroServe uses to store  less important information.  The user program can use it as well.

(request-reply-strategy request)   - accessor - the strategy is a list of symbols which describe how AllegroServe will build a response stream and will send back a response.  More details will be given about the possible strategies at a future time.

(request-reply-stream request)       - accessor -  This is the stream to be used in user code to send back the body of the response.    This stream must  be used instead of the value of request-socket.

 

CGI Program Execution

The Common Gateway Interface (CGI) specification allows web servers to run programs in response to http requests and to send the results of  the execution of those programs back the web client.    The CGI programs finds information about the request in its environment variables and, in the case of a put or post request, the body of the request is sent to standard input of the program.

CGI is a clumsy and slow protocol for extending the behavior or a web server and is falling out of favor.  However there are legacy CGI applications you may need to call from AllegroServe.   You invoke an external program using the CGI protocol with the run-cgi-program function.

(run-cgi-program req ent program &key path-info path-translated
                                      script-name query-string
                                      auth-type timeout error-output env)

In response to an http request, this runs program which must be a string naming an exectuable program or script followed optionally by command line arguments to pass to that program.  Before the program is run the environment variables are set according the the CGI protocol.  The timeout argument is how long AllegroServe should wait for a response from the program before giving up.   The default is 200 seconds.   The error-output argument specifies what should be done with data the cgi program sends to its standard error.   This is described in detail below.  The other keyword arguments allow the caller to specify values for the CGI environment variables that can't be computed automatically.  path-info specifies the PATH_INFO environment variable, and similarly for path-translated, script-name, query-string and auth-type.   If query-string is not given and the uri that invoked this request contains a query part then that query part is passed in the QUERY_STRING environment variable.   If script-name is not given then its value defaults to the path of the uri of the request.   If you wish to add or modify the environment variables set for the cgi process you can specify a value for env.  The value of env should be a list of conses, the car of each cons containing the environment variable name (a string) and the cdr of each cons containing the environment variable value (a string).   env is checked after all the standard environment variables are computed and the value given in env will override the value computed automatically.

cgi programs send their result to standard output (file descriptor 1 on Unix).  If they encounter problems they often send informative messages to standard error (file descriptor 2 on Unix).    The error-output argument to run-cgi-program allows the caller to specify what happens to data sent to standard error.   The possibile values for error-output are:

nil The cgi program's standard error is made the same as the Lisp process' standard error.   This standard error may not be the same as the current binding of *standard-error*.
pathname or string A file with the given name is opened and standard error is directed to that file.
:output Standard error is directed to the same place as standard output thus the error messages will be mixed into the result of running the cgi program.
symbol or function The function is run whenever there is data available to be read from standard error.  It must read that data.  It must return a true value if it detected an end of file during the read and nil otherwise.    The function takes arguments: req ent stream

A typical way of publishing a CGI page is this:

(publish :path "/cgi/myprog"
         :function #'(lambda (req ent) 
                        (run-cgi-program req ent "/server/cgi-bin/myprog")))

If you're concerned about capturing the error output then here's an example where we supply  a function to collect all the error output into a string. Once collected we simply print it out here but in a real web server you would want to store it in a log file.

(defun cgierr (req ent)
  (let ((error-buffer (make-array 10
                                  :element-type 'character
                                  :adjustable t
                                  :fill-pointer 0)))
    (net.aserve:run-cgi-program
     req ent
     "aserve/examples/cgitest.sh 4"
     :error-output
     #'(lambda (req ent stream)
         (declare (ignore req ent))
         (let (eof)
           (loop
             (let ((ch (read-char-no-hang stream nil :eof)))

               (if* (null ch) then (return))

               (if* (eq :eof ch)
                  then (setq eof t)
                       (return))

               (vector-push-extend ch error-buffer)))
           eof
           )))

    (format t "error buffer is ~s~%" error-buffer)
    ))

 

 

Note: The ability to run CGI programs from AllegroServe was due to features added in Allegro Common Lisp version 6.1.   This will not work in earlier versions of Allegro CL.

Form Processing

Forms are used on web pages in order to allow the user to send information to the web server.   A form consists of a number of objects, such as text fields, file fields, check boxes and radio buttons.   Each field has a name.   When the user takes a certain action, the form data is encoded and sent to the web server.     There are three ways that data can be sent to the web server.  The method used is determined by the attributes of the <form> tag that defines the form

  • <form method="get"> -  The data is made part of the url that is sent to the web server and is separated from the url itself by a question mark.  The AllegroServe url handler code uses (request-query req) to retrieve the alist of form names and values.   This method has a few disadvantages - the amount of data that can be sent is limited since the size of urls is limited.  Also the data is visible to everyone seeing the url and that may not be desirable. 
  • <form method="post"> - The data is sent in the body of the request.    The  AllegroServe url handler should call (request-query req) to retrieve and decode the data posted.    In this case  request-query calls (get-request-body req) to retrieve the body from the web browser and then (form-urlencoded-to-query body) to turn it into an alist that associates form field names with values.
  • <form method="post" enctype="multipart/form-data"> - The data is sent in the body of the request in MIME format, with each field in its own separate MIME entity.    This method is only necessary when one of the fields in the form is a <input type="file"> since that causes the whole contents of a file to be sent from the browser to the web server.   When sending a file you would like to include information such as the filename and content-type of the file, and by sending it in MIME format there is room for this information in the MIME header.   We describe how to retrieve data from such a form next.

Retrieving multipart/form-data information

If you create a form with <form method="post" enctype="multipart/form-data"> then your url handler must do the following to retrieve the value of each field in the form:

  1. Call (get-multipart-header req) to return the MIME headers of the next field.  If this returns nil then there are no more fields to retrieve.  You'll likely want to call parse-multipart-header on the result of get-multipart-header in order to extract the imporant information from the header.
  2. Create a buffer and call (get-multipart-sequence req buffer) repeatedly to return the next chunk of data.  When there is no more data to read for this field, get-multipart-sequence will return nil.     If you're willing to store the whole multipart data item in a lisp object in memory you can call get-all-multipart-data instead to return the entire item in one Lisp object.
  3. go back to step 1

It's important to retrieve all of the data sent with the form, even if that data is just ignored.  This is because there may be another http request following this one and it's important to advance to the beginning of that request so that it is properly recognized.  

Details on the functions are given next.

 

(get-multipart-header request)

This returns nil or  the MIME headers for the next form field in alist form.     If nil is returned then there is no more form data.   See parse-multipart-header for a simple way to extratacting information from the header.

For an input field such as <input type="text" name="textthing"> the value returned by get-multipart-header would be

((:content-disposition
      (:param "form-data" ("name" . "textthing"))))

For an input field such as <input type="file" name="thefile"> the value returned by get-multipart-header would be something like

((:content-disposition
      (:param "form-data" ("name" . "thefile")
                          ("filename" . "C://down//550mhz.gif")))
 (:content-type "image/gif"))

Note that the filename is expressed in the syntax of the operating system on which the web browser is running.  This syntax may or may not make sense to the Lisp pathname functions of the AllegroServe web server as it may be running on a totally different operating system.

 

(parse-multipart-header header)

This take the value of get-multipart-header and returns values that describe the important information in the header.

The first value returned is

  • :eof  - this header says that there are no more multipart items.   This value is returned when the value of header is nil.
  • :data - the next multipart item is a simple form value.  The second value returned is a string naming the value.  You can retrieve the value itself using repeated calls to get-multipart-sequence or one call to get-all-multipart-data.
  • :file - the next multipart item is a file the user is uploading to the server.    The second value returned in the name of the form item for which this file was given.  The third value is the name of the file as specified by the user to his browser.  The fourth value returned is the MIME Content-Type that the browser is guessing applies to this contents of the file.   The contents of the file can be retrieved using repeated calls to get-multipart-sequence or one call to get-all-multipart-data.
  • :nofile - If a form contains a place for a filename but no filename was entered before the form was submitted then this type of header is sent.  The values returned are the same as those for :file. The third value (the filename) will always be the empty string.
  • nil - This header has a form not recognized by parse-multipart-header.     If you encounter this please let us know about it since we would like enhance parse-multipart-header to understand this type of header.    If you encounter this  type of header you still have to read the contents of the data item that follows the header in order to read the next header.    A call to (get-all-multipart-data req :limit 1000) will read and throw away the following value so you can then read the next header.

(get-multipart-sequence request buffer &key start end external-format)

This retrieves the next chunk of data for the current form field and stores it in buffer.    If start is given then it specifies the index in the buffer at which to begin storing the data.  If end is given then it specifies the index just after the last index in which to store data.

The return value is nil if there is no more data to return, otherwise it is the index one after the last  index filled with data in buffer.

The buffer can be a one dimensional array of character or of (unsigned-byte 8).  For the most efficient transfer of data from the browser to AllegroServe, the program should use a 4096 byte (unsigned-byte 8) array.

If the buffer is  a character array then the data is converted from get-multipart-sequence's (unsigned-byte 8) array to characters using the given external-format (which defaults to the value of *default-aserve-external-format*).

get-multipart-sequence may return before filling up the whole buffer, so the program should be sure to make use of the index returned by get-multipart-sequence.

 

(get-all-multipart-data request &key  type size external-format limit)

This retrieves the complete data object following the last multipart header.    It returns it as a lisp object.   If type is :text (the default) then the result is returned as a lisp string.   If type is :binary then the result is returned as an array of  element-type (unsigned-byte 8).    size (which defaults to 4096) is the size of the internal buffers used by this function to retrieve the data.   You usually won't need to specify a value for this but but if you know the values retrieved are either very small or very large it may may the operation run faster to specify an appropriate size.    external-format is used when type is :text to convert  the octet stream into characters.  It defaults to the value of *default-aserve-external-format*.   limit can be given an integer value that specifies the maximum size of data you're willing to retrieve.  By default there is no limit.  This can be dangerous as a user may try to upload a huge data file which will take up so much Lisp heap space that it takes down the server.   If a limit is given and that limit is reached, get-all-multipart-data will continue to read the data from the client until it reaches the end of the data, however it will not save it and will return the symbol :limit to indicate that the data being send to the sever exceeded the limit.  It will return a second value which is the size of the data the client tried to upload to the server.    If your application intends to handle very large amounts of data being uploaded to the server you would be better off using get-multipart-sequence since with that you can write the data buffer by buffer to the disk instead of storing it in the Lisp heap.

 

In AllegroServe the information sent to the web server as a result of filling out a form  is called a query.  We store a query as a list of conses, where the car of the cons is the name (a string) and the cdr of the cons is the value (another string).    When a query is transmitted by the web browser to AllegroServe it is sent as string using the encoding application/x-www-form-urlencoded.  We provide the following functions to convert between the encoding and the query list:

 

(form-urlencoded-to-query string &key external-format)

Decodes the string and returns the query list.   The default value for external-format is the value of *default-aserve-external-format*.

 

(query-to-form-urlencoded query &key external-format)

Encodes the query and returns a string.   The default value for external-format is the value of *default-aserve-external-format*.

 

Examples:

user(4): (query-to-form-urlencoded '(("first name" . "joe") 
                                     ("last name" . "smith")))
"first+name=joe&last+name=smith"

user(5): (form-urlencoded-to-query "first+name=joe&last+name=smith")
(("first name" . "joe") ("last name" . "smith"))
 
user(6): (query-to-form-urlencoded
            `(("last name" . ,(coerce '(#\hiragana_letter_ta
                                        #\hiragana_letter_na
                                        #\hiragana_letter_ka)
                                      'string)))
              :external-format :euc)
 "last+name=%a4%bf%a4%ca%a4%ab"
user(7): (query-to-form-urlencoded
            `(("last name" . ,(coerce '(#\hiragana_letter_ta
                                        #\hiragana_letter_na
                                        #\hiragana_letter_ka)
                                      'string)))
             :external-format :shiftjis)
 "last+name=%82%bd%82%c8%82%a9"

user(8): (coerce
           (cdr
              (assoc "last name"
                (form-urlencoded-to-query "last+name=%82%bd%82%c8%82%a9"
                                      :external-format :shiftjis)
                :test #'equalp))
           'list)
 (#\hiragana_letter_ta #\hiragana_letter_na #\hiragana_letter_ka)

Authorization

You may want to restrict certain entities to be accessible from only certain machines or people.   You can put the test for authorization in the entity response function using one of the following functions, or you can have the check done automatically by storing a list of authorizer objects in the entity.

 

functions

These two functions  invoke and process the Basic Authorization Method   defined by the http specification.    The password-authorizer class described below make use of these functions.

(get-basic-authorization request)

This function retrieves the Basic authorization information associated with this request, if any.    The two returned values are the name and password, both strings.  If there is no Basic authorization information with this request, nil is returned.

 

(set-basic-authorization request realm)

This adds a header line that requests Basic authorization in the given realm (a string).    This should be called between with-http-response and with-http-body and only for response of type 401 (i.e. *response-unauthorized*).    The realm is an identifier, unique on this site, for the set of pages for which access should be authorized by a certain name and password.

 

This example manually tests for basic authorization where the name is foo and the password is bar.

(publish :path "/secret"
    :content-type "text/html"
    :function
    #'(lambda (req ent)
        (multiple-value-bind (name password) (get-basic-authorization req)
           (if* (and (equal name "foo") (equal password "bar"))
             then (with-http-response (req ent)
                    (with-http-body (req ent)
                      (html (:head (:title "Secret page"))
                            (:body "You made it to the secret page"))))
             else ; this will cause browser to put up a name/password dialog
                  (with-http-response (req ent :response *response-unauthorized*)
                     (set-basic-authorization req "secretserver")
                     (with-http-body (req ent)))))))

authorizer classes

The authorizer slot of an entity object can contain a authorizer object or a list of zero or more authorizer objects.  When a request arrives for this entity the authorizer objects are consulted to see if this request should be permitted.   In order for the request to be permitted, all authorizer objects must permit the request.  AllegroServe supplies three   interesting subclasses of authorizer and users are free to add their own subclasses to support their own authorization needs.  

The protocol followed during authorization is this:

  1. an entity object is selected that matches the request.  The value of the entity's authorizer slot is retrieved from the entity object.
  2. if the list of pending authorizer objects is nil then it is considered authorized.
  3. otherwise the authorize generic function is called on the first authorizer object, passing authorize the authorizer object, the http-request object and the entity object
  4. the return value from authorize can be 
    t - meaning this request is authorized to access this entity.  In this case the first authorizer object is popped from the list of pending authorizer objects and we go back to step 2.
    nil - meaning that this request isn't authorized.  The response from AllegroServe will be the standard "failed request" response so the user won't be able to distinguish this response from one that would be received if the entity didn't exist at all.
    :deny - a denied request response will be returned.   It will not use the 401 return code so this will not cause a password box to be displayed by the browser.
    :done - the request is denied, and a response has already been sent to the requestor by the authorize function so no further response should be made.

 

password-authorizer  [class]

This subclass of authorizer is useful if you want to protect an entity using the Basic authorization scheme that asks for a name and a password.     When you create this class of object you should supply values for the two slots:

Slot Name initarg what
allowed :allowed list of conses, each cons having the form ("name" . "password") where any of the listed name password pairs will allow access to this page.
realm :realm A string which names the protection space for the given name and password.   The realm will appear in the dialog box the browser displays when asking for a name and password.

An example of it's use is the following where we allow access only if the user enters a name of joe and a password of eoj or a name of fred and a password of derf.

  (publish :path "/foo"
    :content-type "text/html"
    :authorizer (make-instance 'password-authorizer
                       :allowed '(("joe" . "eoj")
                                  ("fred" . "derf"))
                       :realm "SecretAuth")

    :function
    #'(lambda (req ent)
        (with-http-response (req ent)
           (with-http-body (req ent)
              (html (:head (:title "Secret page"))
                    (:body "You made it to the secret page"))))))

 

location-authorizer [class]

This authorizer class checks the IP address of the request to see if it is permitted access to the entity.  The  authorizer can specify a sequence of  patterns and for each pattern a command of :accept (permit the access) or :deny (forbid the access).    The first pattern that matches determines if the request is accepted or denied.  If the pattern list is empty or if no pattern matches, then the request is accepted. 

The single slot of an object of class location-authorizer is

Slot Name initarg what
patterns :patterns a list of patterns and commands, where the syntax of a pattern-command is described below.

A pattern can be

  • :accept -- this is a pattern that matches all IP addresses and causes the access to be authorized
  • :deny -- this is a pattern that matches all IP addresses and causes the access to be rejected
  • (:accept ipaddress [bits]) --  if the request's IP address matches the most significant bits of ipaddress then this access is accepted.   bits is optional and defaults to 32 (the whole address).  The ipaddress can be an integer (the 32 bit IP address) or it can be a string in either dotted form "123.23.43.12"  or a host name "foo.bar.com".   In the case of a host name, a lookup must be done to map the host name to an  IP address.   If this lookup fails then it is assumed that the pattern doesn't match.   If ipaddress is a string, then the first time it is examined during authorization it is converted to an integer IP address and that value replaces the string in the pattern (thus caching the result of the conversion to an IP address).
  • (:deny ipaddress [bits]) -- just like the case above except the request is rejected if it matches the ipaddress.   One difference is this: if the ipaddress is a host name and that host name cannot be translated to an IP address, then it is assumed to match, and thus the request will be denied. 

The example of using a location-authorizer only permits connections coming in via the loopback network (which occurs if you specify http://localhost/whatever) or if they come from one particular machine (tiger.franz.com).  Note that we end the pattern list with :deny so that anything not matching the preceding patterns will be denied.

(publish :path "/local-secret-auth"
    :content-type "text/html"
    :authorizer (make-instance 'location-authorizer
                         :patterns '((:accept "127.0" 8)
                                     (:accept "tiger.franz.com")
                                     :deny))

    :function
    #'(lambda (req ent)
        (with-http-response (req ent)
           (with-http-body (req ent)
               (html (:head (:title "Secret page"))
                     (:body (:b "Congratulations. ")
                       "You made it to the secret page"))))))

function-authorizer   [class]

This authorizer contains a function provided by the user which is used to test if the request is authorized.   The function take three arguments, the http-request object, the entity and the authorizer object.   It must return one of the four value that the authorize function returns, namely t, nil :deny or :done.

A function-authorizer is created as follows

(make-instance 'function-authorizer
    :function #'(lambda (req ent auth)
                          t  ; always authorize
                 ))

The function slot can be set using (setf function-authorizer-function) if you wish to change it after the authorizer has been created.

 

Cookies

Cookies are name value pairs that a web server can direct a web browser to save and then pass back to the web server under certain circumstances.   Some users configure their web browsers to reject cookies, thus you are advised against building a site that depends on cookies to work.

Each cookie has these components:

  1. name - a string.   Since you can get multiple cookies sent to you by a web browser, using a unique name will allow you to distinguish the values.
  2. value - a string
  3. path - a string which must be the prefix of the request from the web browser for this cookie to be sent.  The string "/" is the prefix of all requests.
  4. domain - a string which must be the suffix of the name of the machine where the request is being sent in order for this cookie to be sent.
  5. expiration - a time when this cookie expires.
  6. secure - either true or false.  If true then this cookie will only be sent if the connection is through a secure socket

 

(set-cookie-header request &key name value expires domain path secure encode-value external-format)

This function should be called between the calls to with-http-response and with-http-body.   It can be called more than once.  Each call will cause one Set-Cookie directive to be sent to the web browser.     The name and value arguments should be given (and they should be strings).  They will be automatically encoded using the same encoding used in urls (we call it uriencoding). The purpose of this encoding is to convert characters that are either unprintable or those that have a special meaning into a printable string.    The web browser doesn't care about the name and value, it just stores them and sends them back to the web server.     If you use the get-cookie-values function to retrieve the cookie name and value pairs, then it will automatically decode the uriencoding.

You can disable the encoding of the value by specifying a nil value to encode-value.    This should only be necessary if you are working with buggy http client applications.

If the path argument isn't given, it will default to "/" which will allow this cookie to match all requests.
If the domain argument isn't given then it will default to the host to which this request was sent.  If you wish to specify this you are only allowed to specify a subsequence of the host to which this request was sent (i.e the name of the machine running the webserver).   The domain should have at least two periods in it (i.e.  ".foo.com").
expires can be a lisp universal time or it can be the symbol :never meaning this should never expire.  If expires isn't given or is nil then this cookie will expire when the user quits their web browser.
secure should be true or false.  Any non-nil value is interpreted as true. The default value is false.
The external-format is used to convert bytes to characters.   It defaults to the value of *default-aserve-external-format*.

 

(get-cookie-values request &key external-format)

Return the cookie name and value pairs from the header of the request.   Each name value pair will be in a cons whose car is the name and whose cdr is the value.   The names and values will be decoded (in other words the decoding done by set-cookie-header will be undone).    The external-format is used to convert bytes to characters.   It defaults to the value of *default-aserve-external-format*.

 

Variables

These special variables contain  information about AllegroServe or help control AllegroServe:

*aserve-version* - a list of three values: (major-version minor-version sub-minor-version) which is usually printed with periods separating the values (i.e. X.Y.Z).

*default-aserve-external-format* - a symbol or external format object which is the default value for those AllegroServe functions that take an external-format argument.   http requests are normally run in separate lisp threads and those threads bind *default-aserve-external-format* to the value of the external-format argument to the start function.   Thus changing the value of *default-aserve-external-format* in one thread will not affect its value in other threads.   You should decide the default external format before you start AllegroServe running.

*http-response-timeout* - the default value for the timeout argument to with-http-response.   [in future versions of AllegroServe we'll treat this value like *default-aserve-external-format* and bind it in each worker thread]

*mime-types* - a hash table where the keys are the file types (e.g. "jpg") and the values are the MIME types (e.g. "image/jpeg").

 

AllegroServe request processing protocol

We'll describe here the steps AllegroServe goes through from the time it receives a request until a response to that request has been sent back to the browser.    We want the protocol to be open so that users can extend AllegroServe's behavior to suit their needs.  However given that AllegroServe is a new program and will be undergoing extensive review from its users, we expect that the protocol will change.   It shouldn't lose any of its current extensibility but the names and argument lists of generic functions may change. 

When a client connects to the port on which AllegroServe is listening, AllegroServe passes that connected socket to a free worker thread which then wakes up and calls the internal function net.aserve::process-connection.   If there are no free worker threads then AllegroServe waits for one to be available.

In each worker thread the variable *wserver* is bound to the wserver object that holds all the information about the webserver on which the connection was made (remember that one AllegroServe process can be running more than one webserver).   process-connection reads the request from the socket (but doesn't read past the header lines).     If the request can't be read within *read-request-timeout* seconds (currently 20) then the request is rejected.    The request is stored in an object of class http-request.    Next process-connection calls handle-request to do all the work of the request and then log-request to log the action of the request.  Finally if the response to the request indicated that the connection was to be kept open rather than being closed after the response, then process-connection loops back to the top to read the next request.

 

(handle-request (req http-request))    [generic function]

This generic function must locate the entity to handle this request and then cause it to respond to the request.   If there is no matching entity then handle-request must send a response back to the client itself.  handle-request uses locators to find the entity (more on this below), and then if an entity is found and that entity has an authorizer, it calls authorize to see if this request is allowed to access the selected entity.  If the entity passes the authorization then process-entity is called to cause the entity to respond to the request.  process-entity returns true if it processed the entity, and nil if did not in which case the search continues for an entity.  If there is no entity to respond then failed-request is called to send back a failure message.

A locator is an object used to map requests into entities.    The value of (wserver-locators *wserver*) is a list of locator objects.   handle-request calls

(standard-locator (req http-request) (loc locator)) [generic function]

on each successive locator in that list until one returns an entity object.     AllegroServe has two built-in locator classes, locator-exact and locator-prefix, that are subclasses of locator.   When you call publish or publish-file you are adding the entity to locator of class locator-exact found in the wserver-locators list.   When you call publish-directory you are adding to the locator of class locator-prefix.    Users are free to define new locator classes.    Locators should define the standard-locator method as well as

(unpublish-locator (loc locator))    [generic  function]

which if called should remove all published entities from the locator.

 

Let's return to handle-request.  It has called standard-locator and found an entity.   Next it checks to see if the entity has an authorizer value and if so calls

(authorize (auth authorizer) (req http-request) (ent entity))   [generic function]

The return value will be one of

  • t -- The request is authorized,  call process-entity to make the entity respond.
  • nil -- The request is not authorized, call failed-request to send back a response.
  • :deny -- The request is denied and we want the user to know that it was denied rather than sending a generic failed message, call denied-request to send back a response.
  • :done -- The authorize function has sent back a response, there is nothing more for handle-request to do for this request.

If there is no authorizer for this entity then we just call process-entity.    If there is no entity, then we call failed-request.

 

(failed-request (req http-request))    [generic function]

send back a response to the effect that the url request doesn't exist on this server.

 

(denied-request (req http-request))   [generic function]

send back a response to the effect that access to the requested url was denied.

 

(process-entity  (req http-request) (ent entity))    [generic function]

Send back a response appropriate to the given entity.     The macros with-http-response and with-http-body should be used in the code that sends the response.

 

 

Client functions

AllegroServe has a set of functions that perform http client-side actions.   These functions are useful in generating computed pages that reflect the contents of other pages.  We also use the client-side http functions to test AllegroServe.

The client-side functions described in this section are exported from the net.aserve.client package.

The function do-http-request sends a request and retrieves the whole response.    This is the most convenient function to use to retrieve a web page.

If you need more control over the process you can use the functions: make-http-request, read-client-response-headers and client-request-read-sequence.

 

(do-http-request uri &key method protocol accept
                          content content-type query format cookies
                          redirect redirect-methods basic-authorization
                          keep-alive headers proxy user-agent external-format ssl
                          skip-body)

Sends a request to uri and returns four values:

  1. The body of the response.  If there is no body the empty string is returned.
  2. the response code (for example, 200, meaning that the request succeeded)
  3. an alist of headers where the car of each entry is a lowercase string with the header name and the cdr is a string with the value of that header item.
  4. the uri object denoting the page accessed.  This is normally computed from the uri value passed in but if redirection was done then this reflects the target of the redirection.  If you plan to interpret relative html links in the body returned then you must do so with respect to this uri value

The uri can be a uri object or a string.   The scheme of the uri must be nil or "http".   The keyword arguments to do-http-request are

Name default description
method :get The type of request to make.  Other possible values are :put, :post and :head.  :head is useful if you just want to see if the link works without downloading the data.
protocol :http/1.1 The other possible value is :http/1.0.  Modern web servers will return the response body in chunks if told to use the :http/1.1 protocol.  Buggy web servers may do chunking incorrectly (even Apache has bugs in this regard but we've worked around them).  If you have trouble talking to a web server you should try specifying the :http/1.0 protocol to see if that works.
accept "*/*" A string listing of MIME types that are acceptable as a response to this request.  The type listed can be simple such as "text/html" or more complex like "text/html, audio/*"  The default is to accept anything which is expressed "*/*".
content nil If the method is :put or :post then the request should include something to be sent to the web server.   The value of this argument is either a string or a vector of type (unsigned-byte 8) which will be sent to the web server.   It may also be a list of strings or vectors. See the query argument for a more convenient way to :post data to a form.
content-type nil A string which is to be the value of the Content-Type header field, describing the format of the value of the content argument.    This is only needed for :put and :post requests.
query nil This is a query alist of the form suitable for query-to-form-urlencoded.   If the method is a :get then the value of  this argument is urlencoded and made the query string of the uri being accessed.  If the method is :post then the query string is urlencoded and made the content of the request.  Also the content-type is set to application/x-www-form-urlencoded.
format :text The body of the response is returned as a string if the value is :text or as an array of type (unsigned-byte 8) if the value is :binary.    When the body is a string the external-format argument is important.
cookies nil If you wish the request to include applicable cookies and for returned cookies to be saved, then a cookie-jar object should be passed as the value of this argument.
redirect 5 If the response is a redirect (code 301, 302, 303), and the method is one given by the value of redirect-methods then if this argument is true (and, if an integer, positive), do-http-request will call itself to access the page to which the redirection is pointed.  If redirect is an integer then in the recursive call the value passed for redirect will be one less than the current value.  This prevents infinite recursion due to redirection loops.
redirect-methods (:get :head) List of http methods which will be redirected if redirect is true.
basic-authorization nil If given, it is a cons whose car is the name and whose cdr is the password to be used to get authorization to access this page.
keep-alive nil If true then the web server will be told to keep the connection alive.    Since do-http-request closes the connection after the request this option currently does no more than allow us to experiment with how a web server responds to a keep-alive request.
headers nil an alist of conses ("header-name" . "header-value") for additional headers to send with the request.
proxy nil the name and optionally the port number of a proxying web server through which this request should be made.   The form is of the argument is "www.machine.com" or "www.machine.com:8000" if the web server is listening on port 8000 rather than 80.   Proxying web servers are often used when clients are behind firewalls that prevent direct access to the internet.   Another use is to centralize the page cache for a group of clients.
user-agent nil If given it specifies the value of the User-Agent header to be sent with the request.  Some sites respond differently based on the user-agent they believe has made the request.  The lack of a User-Agent header may cause a server to ignore a request since it believes that it is being probed by a robot.  The value of user-agent can be a string or one of the keywords :aserve, :netscape or :ie in which case an appropriate user agent string is sent.
external-format the value of *default-aserve-external-format* This determines the socket stream's external format.
ssl nil If true then the connection is made using the Secure Sockets Layer protocol.    If the uri uses the https scheme then ssl is assumed to be true and the ssl argument need not be specified.
skip-body nil If the value is a fucntion (satisifies functionp) then the value is funcalled passing the client-request object as an argument.   At this point the client-request object contains the information on the headers of the response.   The function should return true if the body of the response should be skipped and nil returned as the first value from do-http-request.  If skip-body is not a function then if its value is true then reading the body is skipped and nil returned in its place.

 

For example:

user(5): (do-http-request "http://www.franz.com")

"<HTML>
    <HEAD>
        <TITLE>Franz Inc: Allegro Common Lisp and Common Lisp Products</TITLE>
        <BASE FONTFACE=\"helvetica, arial\" FONTSIZE=\"1\">
.....
"
200
(("content-type" . "text/html") ("transfer-encoding" . "chunked")
("server" . "Apache/1.3.9 (Unix) PHP/3.0.14")
("date" . "Mon, 24 Apr 2000 11:00:51 GMT"))

 

It's easy to use do-http-request to fill in form objects on a page.   If the form has input elements named  width and height then you can send a request that specifies that information in this way:

(do-http-request "http://www.foo.com/myform.html" 
                 :query '(("width" . 23) ("height" . 45)))

The above assumes that the method on the form is "GET".   If the method is "POST" then a similar call will work:

(do-http-request "http://www.foo.com/myform.html"  :method :post
                 :query '(("width" . 23) ("height" . 45)))


       

 

Before we describe the lower level client request functions we will describe two classes of objects used in that interface.

client-request

A client-request object includes the information about the request and the response.

The public fields of a client-request that are filled in after a call to make-http-client-request are:

Accessor Description
client-request-uri uri object corresponding to this request
client-request-socket socket object open to the web server denoted by the uri
client-request-cookies the cookie-jar object (if any) passed in with this request.

 

After read-client-response-headers is called, the following fields of the client-request objects are set:

Accessor Description
client-request-response-code the integer that is the response code for this request.  The most common codes are 200 for Success and 404 for Not Found.
client-request-headers an alist of header values in the response.  Each entry is a cons of the form ("header-name" . "header-value").   The header names are all lower case.
client-request-protocol A keyword symbol naming the protocol  that the web server returned (which may be different that the protocol given in the request).   A typical return value is :http/1.1
client-request-response-comment A string giving a textual version of the response code.   The string is arbitrary and you should not depend on all web servers returning the same string for any given response code.

 

cookie-jar

A cookie-jar is a respository for cookies.  Cookies are stored in a jar when a response from a client request includes Set-Cookie headers.   Cookies from a jar are sent along with a request when they are applicable to the given request.   We won't describe the rules for cookie applicability here, you need only know that if you use our client functions  to access a site that uses cookies to implement persistence, then you should create a cookie-jar object and pass that same object in with each request.   More information on cookies can be found here.

A cookie-jar is created with (make-instance 'cookie-jar).

 

(cookie-jar-items  cookie-jar)

returns an alist of the cookies in the jar where each item has the form:

(hostname cookie-item ...)

The hostname is a string which is matched against the suffix of the name of the host in the request (that is, a hostname of  ".foo.com" matches "a.foo.com" and "b.foo.com". ).    The hostname should have at least two periods in it.     The following cookie-item objects in the list all apply to that hostname.    A cookie-item is a defstruct object and has these fields

Accessor Description
cookie-item-path A string that must be the prefix of the path of the request for it to match.  The prefix "/" matches all paths.
cookie-item-name The name of the cookie.  A string.
cookie-item-value The value of the cookie.  A string.
cookie-item-expires A string holding the time the cookie expires [in a future release we may make this a universal time]
cookie-item-secure true if this cookie should only be sent over a secure connection.

 

 

(make-http-client-request uri &key method protocol keep-alive
                                   accept cookies headers proxy
                                   basic-authorization query
                                   content content-type content-length
                                   user-agent external-format ssl)

This function connects to the web server indicated by the uri and sends the request.   The arguments are the same as those for do-http-request and are documented there.   There is one additional argument: content-length.    This argument can be used to set the content-length header value in the request.  After setting the content-length the caller of make-http-client-request would then be responsible for sending that many bytes of data to the socket to serve as the body of the request.   If content-length is given, then a value for content should not be given.

If  make-http-client-request succeeds in contacting the web server and sending a request, a client-request object is returned.    If make-http-client-request fails, then an error is signalled.

The returned client-request object contains an open socket to a web server, thus you must ensure that client-request object isn't discarded before client-request-close is called on it to close the socket and reclaim that resource.

After calling make-http-client-request the program will send the body of the request (if any), and then it will call read-client-response-headers to partially read the web server's response to the request.

The default value for external-format is the value of *default-aserve-external-format*

 

 

(read-client-response-headers client-request)

This function reads the response code and response headers from the web server.     After the function returns the program can use the client-request accessors noted above to read the web server's response.  The body of the response (if any) has not been read at this point.    You should use client-request-read-sequence to read the body of the response

 

 

(client-request-read-sequence buffer client-request
                              &key start end)

This fills the buffer with the body of the response from the web server.   The buffer should either be a character array or an array of (unsigned-byte 8).    If given, start specifies the index of the first element in the buffer in which to store, and end is one plus the index of the last element in which to store. 

The return value is one plus the last index in the buffer filled by this function. The caller of the function must be prepared for having the buffer only partially filled.   If the return value is zero then it indicates an End of File condition.

 

(client-request-close client-request)

The client-request object returned by make-http-request is closed.   This returns the resources used by this connection to the operating system. 

 

(uriencode-string  string &key external-format)

Convert the string into a format that would be safe to use as a component of a url.     In this conversion most printing characters are not changed    All non printing characters and printing characters that could be confused with characters that separate fields in a url are encoded a %xy where xy is the hexadecimal representation of the char-code of the character.  
external-format defaults to the value of *default-aserve-external-format*.

Proxy

AllegroServe can serve as an http proxy.   What this means is that web clients can ask AllegroServe to fetch a URL for them.   The two primary uses for a proxy server are

  1. you have web clients on a local network and you would prefer that the web clients don't send messages out to the internet.   You run AllegroServe on a machine that has access both to the internal network and to the internet.  You then configure the web clients to proxy through AllegroServe (directions for doing this are given below).
  2. You wish to use AllegroServe's caching facility to store copies of pages locally to improve responsiveness.  In this case you must start AllegroServe as a proxy server for the web clients who will use the cache.

In order to run AllegroServe as a proxy server you should specify :proxy t in the arguments to the net.aserve:start function.   With this specified AllegroServe will still act as a web server for pages on the machine on which AllegroServe is running.  AllegroServe will act as a proxy for requests to other machines.

Each web browser has it's own way of specifying which proxy server it should use.   For Netscape version 4 select the Edit menu, then Preferences... and then click on the plus sign to the left of Advanced.   Then select Proxies and click on  Manual Proxy Configuration and the click on View and specify the name of the machine running AllegroServe and the port number on which AllegroServe is listening.   Then click OK on all the dialog boxes.

For Internet Explorer 5 select the Tools menu, and then Internet Options.. and then the Connections tab, and then LAN Settings.   Click on Use a Proxy Server and then click on Advanced and specify the machine name and port number for AllegroServe.  Then click on OK to dismiss the dialog windows.

 

Cache

The AllegroServe cache is a facilty in development.  We'll describe here the current status of the code.

The cache consists of a memory cache and a set of zero or more disk caches.      Items initially live in the memory cache and are moved to the disk caches when the memory cache fills up.   Items enter the memory cache due to a page being accessed via the proxy server.   Items in the disk cache move back to the memory cache if the data portion must be sent back to the requesting client (some requests can be answered without sending back the contents of the page and for these the item stays in the disk cache).

You specify the sizes of each cache.   The disk caches will never grow beyond the size you specified but the memory cache can exceed the specified size for a short time.  A background thread moves items from the memory cache to the disk caches and we will allow you to control how often that thread wakes up and ensures that the memory cache is within the desired constraints.

When net.aserve:start is called you specify if you want caching and if so what size caches you want.   A sample argument pair passed to net.aserve:start is

:cache '(:memory 10000000 :disk ("/tmp/mycache" 30000000) :disk (nil 20000000))

This says that the memory cache should be 10,000,000 bytes and that there should be two disk caches.   One disk cache is the file "/tmp/mycache" and can grow to 30,000,000 bytes and the other cache will have a name chosen by AllegroServe and it can grow to 20,000,000 bytes.   We should note here that one thing that distinguishes the AllegroServe caching facilty from that found in many other http proxy-caches is that AllegroServe uses a few  large cache files rather than storing each cached item in a separate file in the filesystem.  

A few other ways of specifying caching at startup is:

:cache t

This will create a memory case of the default size (currently 10 megabytes) and it will create no disk caches.

:cache 20000000

This will create a memory cache of 20,000,000 byte and no disk caches.

 

When caching is enabled we publish two links to pages showing cache information.    This is useful during debugging and is likely to change in the future.   The two pages are  /cache-stats  and  /cache-entries.

 

Request Filters

After AllegroServe reads a request and before it checks the locators to find an entity to handle the request, AllegroServe runs the request through a set of filters.

A filter is a function of one argument: the http-request object. The filter examines and possibily alters the request object. The idea is that filters can do large scale and simple url rewriting, such as changing all requests for one machine to another machine. The filtering occurs before the test to see if this is a proxy request so a filter can change a proxy request to a non proxy request or vice versa.

The currently active filters are found in two places.  First the vhost-filters function of the applicable vhost returns a set of vhost specific filters.   Next the wserver-filters function on the current wserver object returns a set of server global filters.     Both of these functions are setf'able to change the set of filters.

 

A filter function returns :done if no more filters should be run after this one. If the filter returns anything else then subsequent filters in the list are run as well.   If a filters in the vhost list returns :done then the server global filters are not even checked.

When a filter function runs it's most likely going to be looking at two slots in the request object, which are accessed via these functions:

  • request-raw-uri - the actual uri given in the http command
  • request-uri - a constructed uri starting with the raw uri and adding information from the Host header field. This value is used to find the entity to run thus it has all the information about the request.

Also the value of (header-slot-value request :host) is important to check and possibly change.

If the browser is setup to access the internet directly then a request from the user for
    http://foo.bar.com:23/whatever

will cause the request to be sent to the server at foo.bar.com port 23 and the request will have:

  1. the request-raw-uri is /whatever
  2. the request-uri is http://foo.bar.com:23/whatever
  3. the Host header value is "foo.bar.com:23"




If the browser is setup to send all requests through a proxy at proxy.blop.com then a request for
http://foo.bar.com:23/whatever
will come to proxy.blop.com and will have a different raw uri:

  1. the request-raw-uri is now http://foo.bar.com:23/whatever
  2. the request-uri is still http://foo.bar.com:23/whatever
  3. the Host header value is still "foo.bar.com:23"

If the filter wants to alter the destination of request it should ensure that the three values mentioned above are set appropriately for the destination. If the new destination is not served by the current allegroserve wserver, then the filter will have to make sure to turn it into a proxy request (and this will only work if this AllegroServe was started with proxying enabled).

 

Virtual Hosts

It is possible for a single web sever to act like two or more indepenent web servers.   This is known as virtual hosting.  AllegroServe supports the ability to run any number of virtual hosts in a single instance of AllegroServe.

AllegroServe runs on a single machine and listens for requests on one port on one or more more IP addresses.   When a request arrives there is usually a header line labelled Host whose value is the specific hostname typed into the browser by the user.   Thus if hostnames www.foo.com and www.bar.com both point to the same machine then it's possible for the webserver on that machine to distinguish a request for http://www.foo.com from a request for http://www.bar.com by looking at the Host header.

In order to make AllegroServe easy to use you can ignore the virtual hosting facility until you plan to use it.   As long as you don't specify a :host argument to any of the publish functions when adding content to your site, everything you publish will be visible from your web server no matter which hostname the web browser uses to access your site.  If you decide you want to make use of virtual hosting, then read on.

vhost class

In AllegroServe a virtual host is denoted by a instance of class vhost.    The contents of a vhost object are:

Accessor Function What initarg
vhost-log-stream Stream to which to write logging information on requests to this virtual host :log-stream
vhost-error-stream Stream to which AllegroServe sends informational and error messages that are generated during request processing. :error-stream
vhost-names A list of all the names for this virtual host.  :names
vhost-filters list of filter functions :filters

The defaults values for the two streams in a vhost object is the wserver-log-stream from the server object.

Every instance of AllegroServe has a default vhost object that can be retrieved from the wserver object via the function wserver-default-vhost.    If a request comes in for a virtual host that's not known, then it's assumed to be for the default virtual host.

There are two ways to create virtual hosts in AllegroServe: implicitly or explicitly.    If a publish function is called with a :host value that names a host not known to be a virtual host then a vhost instance will be created automatically and stored in the wserver's hash table that maps names to vhost objects.  This is implicit virtual host creation.

If you know ahead of time the virtual hosts you'll be serving then it's better to setup all the virtual hosts explicitly.   You create a vhost instance with make-instance and you register each virtual host in the wserver-vhosts table using gethash.     Following is an example of setting up a server to have two virtual hosts, one that responds to three names and one that responds to two names.   Since we are using the default vhost to represent the first virtual host, this virtual host will also receive requests for names we haven't mentioned explicitly.

 

(defun setup-virtual-hosts (server)
  (let ((vhost-table (wserver-vhosts server))
	(foo-names '("localhost" "www.foo.com" "foo.com"))
	(bar-names '("www.bar.com" "store.bar.com")))
    
    (let ((default-vhost (wserver-default-vhost server)))
      (setf (vhost-names default-vhost) foo-names)
      (dolist (name foo-names)
	(setf (gethash name vhost-table) default-vhost)))
    
    (let ((bar-vhost (make-instance 'vhost :names bar-names)))
      (dolist (name bar-names)
	(setf (gethash name vhost-table) bar-vhost)))))

When a request comes in, AllegroServe will determine which vhost is the intended target and if none is found it will select the default vhost as the intended target.  The vhost so determined will be stored in the http-request object in the slot accessed by request-vhost function.

host argument to publish functions

We now are in a position to describe what values the :host argument to the publish functions can take on.   The :host argument can be nil or one of:

  1. a string naming a virtual host.  If there is no virtual host with this name a new virtual host object is created.
  2. a vhost object
  3. the symbol :wild
  4. a list of items of the above items

If the value of the :host argument is nil, then its value is assumed to be :wild.

The value of the :host argument is converted into a list of one or more vhost objects and/or the symbol :wild.    The meaning of a vhost is clear: it means that this entity will be visible on this virtual host.   The meaning of :wild is that this entity will be visible on all virtual hosts, except it can be shadowed by a entity specified for a particular virtual host.  Thus you could publish an entity for :path "/" and :host :wild and it will be used for all virtual hosts that don't specify a entity for :path "/".  Note that when a request comes in and the search is done for an entity to match the request every step of the way we look first for a vhost specific handler and then a :wild handler   It is not the case that we first do a complete search for a vhost specific handler and then restart the search this time looking for a :wild handler.

 

Timeouts

A web server is a program that provides resources to client program connecting over the network.  The resources a web server has to offer is limited and it's important that network problems or buggy clients don't cause those resources to be unavailable to new clients.   AllegroServe uses timeouts to ensure that no client can hold a web server resource for more than a certain amount of time.

Three common ways for a resource to be held are

  1. A client stops sending a request in the middle of the request.   This can happen if the client machine crashes or  if the client's machine loses network connectivity with the  machine running AllegroServe.
  2. A client stops reading the response to its request.    The networking code will automatically stop the sender from writing new data if the receiver has a lot of existing data to read.
  3. The response function to an http request can take a very long time, or may even be in an infinite loop.   This could be due to a bug in a http response function or something unexpected, like a database query taking a long time to finish.

 

Acl 6.0 or older

For AllegroServe running in Acl 6.0 or older timeouts are done this way:

net.aserve::*read-request-timeout*  - number of seconds AllegroServe allows for the request line (the first line) and all following header lines.   The default is 20 seconds.

net.aserve::*read-request-body-timeout* - number of seconds AllegroServe allows for the body of the request (if any) to be read.   The default is 60 seconds.

(wserver-response-timeout wserver) - the number of seconds AllegroServe allows for an http request  function to be run and finished sending back its response.  The initial value for this slot of the wserver object is found in *http-response-timeout* which defaults to 120 seconds.  You can alter this timeout value with the :timeout argument to with-http-response or by specifying a :timeout when publishing the entity.

Acl 6.1 or newer

In Acl 6.1 we added the capability of having each I/O operation to a socket stream time out.   This means that we don't have to predict how long it should take to get a request or send a response.  As long as we're making progress reading or writing we know that the client on the other end of the network connection is alive and well.    We still need a timeout to handle case (3) above but we can allow a lot more time for the http response since we aren't using this timer to catch dead clients as well.    Thus we have these timeout values:

(wserver-io-timeout wserver) - the number of seconds that AllegroServe will wait for any read or write operation to the socket to finish.   The value is initialized to the value of *http-io-timeout*   which defaults to 60 seconds.

(wserver-response-timeout wserver) -  the number of seconds AllegroServe allows for an http request function to be run and finished sending back its response. The initial value for this slot of the wserver object is found in *http-response-timeout* which defaults to 300 seconds. You can alter this timeout value with the :timeout argument to with-http-response or by specifying a :timeout argument to the publish function creating the entity.

publish-directory and publish-file default their timeout argument in a way that makes sense based on whether the Lisp supports I/O timeouts.    If I/O timeouts are supported then there is no reason to do a global timeout for the whole response if you're just sending back a file.   Thus in this case the timeout argument defaults to a huge number.

 

Miscellaneous

(ensure-stream-lock stream)

The function adds a process lock to stream's property list (under the indicator :lock) if no such lock is present.   Then it returns the object stream.

The AllegroServe logging functions make use of the stream's lock to ensure that only one thread at a time write log information to the stream.   If the logging functions find that a a log stream doesn't have a lock associated with it then the log information will still be written to the stream but under heavy load the log information from multiple threads will become intermixed.

 

(map-entities function locator)

When one of the publish functions is called enties are placed in locator objects.   The locator objects are then checked when http requests come in to find the appropriate entity.  map-entities will apply the given function of one argument to all the entities in the given locator.   One common use of map-entities is to find entities that you no longer wish to be published.  For that reason map-entities will remove the entity the passed to the function if the function returns the keyword symbol :remove as its value.

 

Running AllegroServe as a Service on Windows NT

On Windows NT (and Windows 2000 and Windows XP) when you log off all the programs you are running are terminated.   If you want to run AllegroServe on your machine after you log out you have to start it as a Windows Service.  This is easy to do thanks to code contributed by Ahmon Dancy.  

The first step is to download the ntservice code and documentation from the Franz opensource site.  Read the documentation carefully especially as regards the different capabilities of the accounts under which you may choose to run AllegroServe.  

You'll probably want to build an AllegroServe application that can run either normally or as a service,.  You can run it normally to debug it and then start it as a service when you're satisifed that it works.

Following is an example of how this can be done.   I've decided that if the /service argument is given on the command line when I start my application then I'll start my application as a service, otherwise I start it normally.      Here is the restart-init-function (to generate-application) that I define:

(defun start-aserve-application ()
  (flet ((start-application ()
	   (net.aserve:start :port 8020)
	   (loop (sleep 100000))))
    (if* (member "/service" (sys:command-line-arguments) :test #'equalp)
     then ; start as  a service
	  (ntservice:start-service #'start-application)
     else ; start as a normal app
	  (start-application)))))

 

I use (loop (sleep 100000)) to ensure that the restart-init-function never returns.

 

In order to register my application as a service to the operating system I call ntservice:create-service like this:

(ntservice:create-service "aservetest" "Aserve Test Service"
     "c:\\acl61\\testservice\\testapp\\testapp.exe -- /service")

Note that I use "--" before the "/service".  This is very important.    The "--" separates the arguments used to start up the program from the arguments passed to the program itself.    The call to ntservice:create-service is done only once and need not be done from within your application. 

Once an application is registered as a service you can start it by going to the Control Panel, selecting Administrative Tools and then Services.   Locate the service you just added, right click on it and select start.   You can stop the service with a a right click as well.

 

Using International Characters in AllegroServe

A character set is a collection of characters and a rule to encode them as a sequence of octets.   The default character set for web protocols is Latin1 (also known as ISO 8859-1).   The Latin1 character set represents nearly every character and punctuation needed for western European languages (which includes English).   

If you want to work with characters outside the Latin1 set you'll want to use the International version of Allegro CL which represents characters internally by their 16-bit Unicode value.    In this section we'll assume that you're using International Allegro CL.

What the web protocols refer to as charset (character set) Allegro CL refers to as an external-format.  Allegro CL uses a different term since it always uses 16-bit Unicode to represent characters internally.  16 bit unicode can represent nearly all characters on the planet.  It's only when those characters are read from or written to devices outside of Lisp that the actual encoding of those characters into octets matters.    Thus the external-format specifies how characters are encoded and specifies which Unicode characters are part of the character set that the external-format defines.  Attempts to write a Unicode character that's not part of the character set results in a question mark being written.

External-formats are also used in Allegro CL to do certain character to character transformations.  In particular on the Windows platform external formats are used to convert the lisp end of line (a single #\newline character) to the #\return #\linefeed character that is standard on Windows.   Thus an external format such as :utf-8   has a different effect on Windows than on Unix, and this is not desireable for web applications.   The function call (crlf-base-ef :utf-8) returns an external format on Windows and on Unix that simply does the character encoding part of the external format, and thus this is the external format you would want to use in a web application.

server to client (browser) character transfer

When a web server returns a response to a client it sends back a response line, a header and optionally a body.   The response line and header are always sent using a subset of the Latin1 character set (the subset corresponding the the US ASCII character set).   The body is sent using the full Latin1 character set, unless otherwise specified.  To specify the character set of the body you add an extra parameter to the Content-Type header.   Instead of specifying a content type of "text/html" you might specify "text/html; charset=iso-8859-2".    This alerts the http client that it must interpret the octets comprising the body of the response according to the iso-8859-2 character set.   This however is not enough to make AllegroServe encode the Unicode characters it's sending to the client using the approrpriate external format.  You would have to do this:

(with-http-response (req ent)
  (with-http-body (req ent :external-format (crlf-base-ef :iso8859-2))
     ... generate and write page here..
))

Note that the charset names and external format name are similar but not identical.   Check here for the charset names and check here for the Allegro CL external format names.

In order to make it easier to specify external formats in AllegroServe you can specify a default external format when you start the server (with the :external-format argument to the start function).   The variable *default-aserve-external-format* will then be bound to this external format in each of the threads that processes http requests.   It's the value of *default-aserve-external-format* that is used as the default argument to the :external-format argument to with-http-body.

The default value of the :external-format argument to the start function, and thus the default value of *default-aserve-external-format*, is (crlf-base-ef :latin1-base).   This means that regardless of the locale in which you run AllegroServe, AllegroServe will by default using the Latin1 character set, which is what is expected by web clients..

A very useful character set is utf-8 which is the whole Unicode character set and thus comprises all of the characters you can store inside Lisp.    The corresponding Allegro CL external format is the value of (crlf-base-ef :utf-8).   Specifying this character set allows you to write web pages that can characters from nearly every language in the world (whether the web browser can find the glyphs to display all those characters is another matter).

client (browser) to server character transfer

The brower sends characters to the web server when the user enters data into a form and submits the form.   The important thing to remember is that the browser will encode characters using the character set that was specified for the web page containing the form.  If you fail to specify a charset when the page was given to the web browser then the web browser will decide on its own how to encode characters that aren't part of the default character set ( which is of course Latin1).    The browser will not tell you which encoding it chose.   Therefore if you ever plan on allowing  non-Latin1 characters to be specified in your forms you'll want to specify a charset for the page containing the form.

You can specify the charset in the Content-Type field of the header that's sent with the page (as we described above) or you can put it in the page itself using a meta tag:

<meta http-equiv="Content-Type" content="text/html; charset=utf-8">

Retrieving form data in AllegroServe is done with the request-query function and that function takes an :external-format argument so you can specify how the form data can be decoded.   If your form sends multipart data then you can use the :external-format argument to get-multipart-sequence to retrieve the form data and decode the data.

examples

The AllegroServe test page has links to a few pages that show how international characters work with AllegroServe.  One of these is the the International Character Display page.  This page  shows what happens when the charset and external-format are set to different values and a page containing international characters is displayed.  It demonstrates how it important is is that those two character set specifications be kept in sync, and it shows that utf-8 is most likely the best choice for a character set for your web pages.

 

Debugging

Debugging entity handler functions is difficult since these are usually run on a separate lisp thread.  Also AllegroServe catches errors in entity handler functions, thus preventing you from interactively diagnosing the problem.

You can put AllegroServe in a mode that makes debugging easier with the net.aserve::debug-on function.   Note that this is not an exported function to emphasize the fact that you are working with the internals of AllegroServe.

 

(net.aserve::debug-on &rest debugging-features-to-enable)

We've classified the debugging features and given each a keyword symbol name.    This function turns on those named features.  If no arguments are given, then debug-on prints the list of debugging features and whether each is enabled.

 

(net.aserve::debug-off &rest debugging-features-to-disable)

This function turns off the given list of features.

 

The list of debug features are:

:info AllegroServe prints information at certain places while doing its processing.  
:xmit AllegroServe prints what it receives from and sends to the client.  In some cases the body of a request or response will not be printed.
:notrap When enabled, this prevents AllegroServe from catching errors in entity handler functions.  If an error occurs and you're running in an evironment where background processes automatically create new windows (such as the emacs-lisp interface) then you'll be given a chance to :zoom the stack and diagnose the problem.  Note that if a timeout has been established to limit the amount of time that a certain step is allowed (and this is done by default) then the interactive debugging session will be aborted when the timeout is reached.

 

Two pseudo debug features are :all and :log..   Specifying :all to debug-on or debug-off   is the same as listing all of the debug features.   Specifying :log is the same as specifying all features except :notrap.

 

cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/doc/cvs.html000066400000000000000000000125431133377100500235460ustar00rootroot00000000000000 cvs

Cvs allows you to automatically merge in the changes we make to Allegro aserve to a copy of the source you may have modified.   This is much easier and less error prone than trying to see what we've changed by comparing source distributions and then merging in the changes yourself.   A copy of the cvs document in pdf format is here.  On our server we are using 1.10.7 of cvs, so you'll want to make sure your cvs client is compatible with that version.

To access our repository via cvs here are the parameters you'll need:

CVSROOT :pserver:cvspublic@cvspublic.franz.com:/cvs-public
password cvspublic

If you use the -d parameter as shown below you won't need to set the CVSROOT environment variable. 

Here is a sample session where you check out aserve for the first time.    First you have to save the password for the account on your machine, and you do that using the cvs login command:

% cvs -d :pserver:cvspublic@cvspublic.franz.com:/cvs-public login
(Logging in to cvspublic@cvspublic.franz.com)
CVS password: cvspublic

Next you check out the source code:

% cvs -d :pserver:cvspublic@cvspublic.franz.com:/cvs-public checkout aserve
cvs server: Updating aserve
U aserve/ChangeLog
U aserve/authorize.cl
U aserve/client.cl
U aserve/decode.cl
U aserve/license-lgpl.txt
U aserve/load.cl
U aserve/loadonly.cl
U aserve/log.cl
U aserve/macs.cl
U aserve/main.cl
U aserve/parse.cl
U aserve/publish.cl
U aserve/readme.txt
U aserve/source-readme.txt
cvs server: Updating aserve/doc
U aserve/doc/aserve.html
U aserve/doc/notes-neo.n
U aserve/doc/rfc2396.txt
U aserve/doc/tutorial.html
cvs server: Updating aserve/examples
U aserve/examples/examples.cl
U aserve/examples/foo.txt
U aserve/examples/fresh.jpg
U aserve/examples/aservelogo.gif
U aserve/examples/prfile9.jpg
U aserve/examples/tutorial.cl
cvs server: Updating aserve/htmlgen
U aserve/htmlgen/htmlgen.cl
U aserve/htmlgen/htmlgen.html
U aserve/htmlgen/test.cl
%

Now you can read aserve/source-readme.txt and learn how to build aserve.  

To see how cvs can help you, suppose you edit aserve/examples/examples.cl and add a new page to be published.  You can ask cvs to tell you what you've changed since you last retrieved the source from our repository:  

% cd aserve

% cvs diff
cvs server: Diffing .
cvs server: Diffing doc
cvs server: Diffing examples
Index: examples/examples.cl
===================================================================
RCS file: /cvs-public/aserve/examples/examples.cl,v
retrieving revision 1.2
diff -r1.2 examples.cl
369a370,378
>
> (publish :path "/hiworld"
> :     content-type "text/html"
>      :function
>      #'(lambda (req ent)
>              (with-http-response (req ent)
>                 (with-http-body (req ent)
>                  "hi world"))))
>
cvs server: Diffing htmlgen
%

You would now like to retrieve the latest version of the source from our repository and merge our changes into your changes.   This is done with one command: executed from the aserve directory created in the cvs checkout command:

% cvs update -d
cvs server: Updating .
P client.cl
cvs server: Updating doc
cvs server: Updating examples
M examples/examples.cl
cvs server: Updating htmlgen
%

The response from the command is terse.  In this case the P before client.cl says that there were changes to that file in the repository that have now been patched into your copy of the source.  The M before examples/examples.cl says that you have local modifications to this file.  If you see a file name preceded by U (as they were in the cvs update command earlier), it means that this a new file that was downloaded in full.  What you must look for is the response C which said that the updating process found conflicts that it couldn't resolve because both we and you modified the same lines in the file.   In this case you must edit the file and look for the lines surrounded by <<<<<<<<<<, ========= and >>>>>>>>>> and remove the markers and resolve the conflict

We've just mentioned a few of the features of cvs, you are advised to read the cvs manual to get the maximum benefit from it.

cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/doc/htmlgen.html000066400000000000000000000505171133377100500244140ustar00rootroot00000000000000 HTML Generation Facility

HTML Generation Facility

This document copyright (c) 2000-2003 Franz Inc.

Introduction

We've defined a pair of macros which enable  a program to generate html in a concise and readable  manner.   These macros are quite a bit different than those found in other html generation systems and thus we'll briefly describe the justification for this design.

html is a concise markup language. There is a tendency in language design to assume that one's users won't be as smart as one's self and thus one tends to dumb things down.  For example, html uses <p> to start a  paragraph.  The language designer says to himself: "while I know that p means paragraph, my users won't so I'll spell it out as with-paragraph."    A similar thing is done for all the other html commands and soon a program to generate html contains so many long markup commands that it's hard to see the text of the document from the markup commands.  A second problem is that as a user you're not sure exactly what html will be generated by some high level with-xxx forms.   If you're trying to generate a particular sequence of html you're left experimenting with the high level forms and hoping that by luck you get the output you want.    A third problem is that with the high level forms you're forced to learn yet another markup language.  There are plenty of books and reference guides to html itself and it's an easy language to master.    Learning  a particular high-level mapping of html is an added burden.

With our html generation macros you write the actual html and we just eliminate some of the tedious parts, such as closing off markup commands.   The result is that the structure of the document is visible and you can use any book on html as a reference.

Example

The following example of generated web page will be useful to refer to in the discussion below of the syntax of the html macro.

(defvar *my-counter* 0)  ; initialize counter variable.
(html (:html
          (:head (:title "My Document"))
          (:body (:h1 "My Document")
            "Hello AllegroServe, the time is "
            (:prin1 (get-universal-time))

            (incf *my-counter*) ; evaluated but not printed
)))

 

This particular example generates a complete web page, but it's possible to use the   html macro to generate partial pages as well.   In this example, the generated page is surrounded by <html> and </html> due to the :html form.    The page contains a header and a body surrounded by their respective html markers.  The body of the document contains a level 1 header followed by the text beginning "Hello, AllegroServe".    Following that is printed the universal time at the time that the page is generated (i.e now rather than when the macro was first processed by lisp).    The following incf expression is evaluated but the result is not printed.   In this case we're keeping a private count of the number of times this page has been accessed.

html macro

Now that you have a sense of how the html macro works, we will describe the syntax in detail.

 

(html form1 form2 ... formn)                     [Macro]

The forms are processed from left to right.  The most  likely effect is that html output is generated.  The output is sent to the stream net.html.generator:*html-stream*.   The html macro is designed to run inside AllegroServe's with-http-body macro which binds *html-stream* to the correct stream.   Also the html-stream macro described below binds *html-stream* before calling html.  The action taken by html depends on what the form looks like at macro-expansion time.    The possibilities are:

  • string -  A string is simply written (using princ) to the output stream.   Thus the string could contain embedded html commands.
  • keyword symbol -  The keyword must name a known html operator.   The result is that the associated html markup command is sent to the output stream.  The mapping of keyword to html command is trivial -- the print name of the keyword is the html command.  So :p  emits <p>.
  • list beginning with a keyword symbol - This names an html operator that may or may not have an associated inverse operator beginning with "/".  The typical result of this form is to emit the associated html markup command, then process the items in the list in the same way as the forms are processed, and then emit the inverse markup command.  Thus (:i "foo") emits <i>foo</i>.      There is a special case when a single element list is given (see below for details).  Also there are some special keywords that are commands to the html macro rather than markup commands.  They are described below.
  • list beginning with a list beginning with a keyword symbol - This is used to specify markup commands that have parameters.  For example
    ((:a href "/foo/bar.html") "the link") turns into <a href="/foo/bar.html">the link</a>.    The arguments are in plist form: a sequence of names and values.  The names are not evaluated, they should be symbols or strings.   We often use keyword symbols for the names since that looks more lisp-like and reduces the number of symbols we create.   The values are evaluated and printed with a function that escapes characters with special meaning in html : <, >, &, ".   If the value is a symbol with a zero length print name, then something special is done:  The name alone is printed without a following equal sign.  For example: ((:option :size 4 :selected '||) "foo") generates <option size="4" selected>foo</option>.    This form of valueless argument is illegal html but in some older browsers it's the required syntax.
  • anything else  - everything else is simply evaluated in the normal lisp way and the value thrown away.

Special cases:

  • (:princ arg1 arg2 .. argn) causes the result of evaluating each of the args to be printed to the html stream using the princ function (which prints without inserting escape characters needed by the lisp reader to read the result).
  • (:prin1 arg1 arg2 ... argn) causes the result of evaluating each of the args to be printed to the html stream using the prin1 function (which prints by inserting escape characters needed by the lisp reader to read the result).
  • (:princ-safe arg1 arg2 .. argn) acts like the :princ case except that the output is scanned for characters that could be considered html markup commands, and if found, these characters are escaped to prevent them from being treated as html markup commands.
  • (:prin1-safe arg1 arg2 .. argn) acts like the :prin1 case except that the output is scanned for characters that could be considered html markup commands, and if found, these characters are escaped to prevent them from being treated as html markup commands.
  • :newline simply inserts a newline into the html output stream.    This will not have an effect on the result as viewed by a web browser (unless it is emitted while inside an html markup command that specifies preformatted input).   The main use for this is to make the resulting html file easier to read by a human.
  • You can conditionally specify arguments to a markup command using an argument name of   :if*. Following the :if* is a lisp expression which if true at runtime will cause the following argument value pair to be included in the argument tag.  For example ((:td :if* (frob) :bgcolor "#00ff00") "xx") will only put bgcolor="#00ff00" in the argument if the expression (frob) returns true at runtime.

 

 

(html-stream stream  form1 form2 ... formn)                     [Macro]

This binds net.html.generator:*html-stream* to the value of the stream argument and then evaluates the form arguments just like the html macro.

 

Examples

We will show how to build a page containing a table using successively more runtime customization of the table.  First we show how to build a table of squares.

defun simple-table-a ()
   (with-open-file (p "test.html"
        :direction :output
        :if-exists :supersede
        :if-does-not-exist :create)

     (html-stream p 
        (:html
         (:head (:title "Test Table"))
         (:body 
           (:table 
            (:tr (:td "0") (:td "0"))
            (:tr (:td "1") (:td "1"))
            (:tr (:td "2") (:td "4"))
            (:tr (:td "3") (:td "9"))
            (:tr (:td "4") (:td "16"))
            (:tr (:td "5") (:td "25"))))))))

The function simple-table-a builds a page containing this table:

0 0
1 1
2 4
3 9
4 16
5 25

It isn't very pretty but it's easy to see the correspondence between the html macro and the resulting table.  Note that if we had done, for example, (:td 1) instead of (:td "1") then nothing would have been emitted.   Only constant strings are printed, not constant integers.  To use an integer here we would have had to do (:td (:princ 1)).

We can use the ability to pass arguments to html markup commands to specify a border around the elements of the table as shown here:

(defun simple-table-b ()
  (with-open-file (p "test.html"
        :direction :output
        :if-exists :supersede)

    (html-stream p 
        (:html
         (:head (:title "Test Table"))
         (:body 
          ((:table border 2)
            (:tr (:td "0") (:td "0"))
            (:tr (:td "1") (:td "1"))
            (:tr (:td "2") (:td "4"))
            (:tr (:td "3") (:td "9"))
            (:tr (:td "4") (:td "16"))
            (:tr (:td "5") (:td "25"))))))))

The resulting table is:

0 0
1 1
2 4
3 9
4 16
5 25


Suppose we wanted to make the table include the squares of numbers from zero to 100.   That would take a lot of typing.  Instead, let's modify the table generation function to compute a table of any size:

(defun simple-table-c (count)
  (with-open-file (p "test.html"
        :direction :output
        :if-exists :supersede)

    (html-stream p 
        (:html
          (:head (:title "Test Table"))
          (:body 
           ((:table border 2)
            (dotimes (i count)
              (html (:tr (:td (:princ i))
                         (:td (:princ (* i i))))))))))))

 

Note that we can freely imbed calls to the html macro within another call.   The dotimes call inside the :body expression is simply evaluated and its value ignored.  However the side effect of the dotimes is to generate more html and to send it to the stream bound in the html-stream call.  The result of (simple-table-c 8) is

0 0
1 1
2 4
3 9
4 16
5 25
6 36
7 49

 

We can specify at runtime values for the arguments to html markup forms.  This function allows us to specify parameters of the table being built:

(defun simple-table-d (count border-width backg-color border-color)
  (with-open-file (p "test.html"
        :direction :output
        :if-exists :supersede)

     (html-stream p 
        (:html
         (:head (:title "Test Table"))
         (:body 
           ((:table border border-width
                bordercolor border-color
                bgcolor backg-color
                cellpadding 3)
            (:tr ((:td bgcolor "blue") 
                  ((:font :color "white" :size "+1")
                   "Value"))
                 ((:td bgcolor "blue") 
                  ((:font :color "white" :size "+1")
                   "Square"))
            )
            (dotimes (i count)
             (html (:tr (:td (:princ i))
                        (:td (:princ (* i i))))))))))))

This demonstrates that in an html markup command argument list the keywords aren't evaluated but the values are.   If we evaluate this expression:

(simple-table-d 10 3 "silver" "blue")

then we generate this table:

Value Square
0 0
1 1
2 4
3 9
4 16
5 25
6 36
7 49
8 64
9 81

 

 

An example of conditional arguments to a markup command is this:

(defun simple-table-e (count)
   (with-open-file (p "test.html"
        :direction :output
        :if-exists :supersede)

     (html-stream p 
        (:html
          (:head (:title "Test Table"))
          (:body 
            ((:table border 2)
             (dotimes (i count)
              (html (:tr 
               (dotimes (j count)
                 (html ((:td :if* (evenp j) :bgcolor "red"
                             :if* (not (evenp j)):bgcolor "green")
                        (:princ (* i j))))))))))))))

This sets the color of the columns to alternately red and green:  Here is (simple-table-e 6)

0 0 0 0 0 0
0 1 2 3 4 5
0 2 4 6 8 10
0 3 6 9 12 15
0 4 8 12 16 20
0 5 10 15 20 25

 

 

 

HTML generation functions

It's possible to express HTML using Lisp data structures.   The form is based on how HTML is written using the html macro above. 

Lisp HTML (lhtml) is defined as one of the following

  • a string, which is rendered as HTML by simply printing it.  Thus the string can contain embedded HTML commands.
  • a list beginning with a valid lhtml keyword and containing lhtml forms.   The valid keywords are those corresponding to the HTML entity tags, plus the special tags :princ, :princ-safe, :prin1, :prin1-safe, :newline and :comment.   These act just as they do in the html macro.   This form is rendered as an opening tag, then the rendering of the body, and a closing HTML tag if one exists.
  • a list beginning with a list beginning with an lhtml keyword.   This is the form used when attributes are to be supplied with the opening entity tag. 

Examples of valid lhtml:

  • "foo<i>bar</i>baz"
  • (:i "foo")
  • ((:body :bgcolor "#xffffff") "the body")

 

(html-print lhtml stream)

Print the Lisp HTML expression lhtml to the stream.

 

(html-print-list lhtml-list stream)

Print the list of lhtml forms to the stream.   This is equivalent to calling html-print on every element of lhtml-list.

 

 

 

cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/doc/tutorial.html000066400000000000000000000761021133377100500246170ustar00rootroot00000000000000 AllegroServe Tutorial

AllegroServe Tutorial

copyright (c) 2000-2001 Franz Inc

This document is a companion to the AllegroServe reference manual.   Here we will take you through various examples and demonstrate how to use the facilities of the AllegroServe web server.   Refer to the reference manual for more details on the functions we mention here.

Loading AllegroServe

AllegroServe is distributed as a single fasl file: AllegroServe.fasl.    If the file is installed where require can find it then you need only type

(require :aserve)

to ensure that it's loaded.  Otherwise you'll have to call the load function.   In the subsequent steps we've assumed that you've loaded AllegroServe into Lisp.

Package setup

AllegroServe consists of two components: a web server and an html generator.  These are located in two Lisp packages: net.aserve and net.html.generator.    These are long package names to type so the first thing to do is to create a package that uses these packages as well as the normal Lisp packages.  Let's create a package called tutorial and make that the current package:

(defpackage :tutorial 
    (:use :common-lisp :excl :net.aserve :net.html.generator))

(in-package :tutorial)

Starting AllegroServe

Normally you would publish all the pages for your site and then start the web server.   That way everyone would see a consistent view of your site.  However, for this tutorial we'll start the server first so that we can immediately see the pages we're publishing.

Web servers normally listen on port 80.  On Unix port 80 can only be allocated by the the superuser (called root).     On Windows any user can open port 80 as long as it's not yet allocated.    In order to make this tutorial work on both Unix and Windows (and not require that you run as root on Unix), we'll put our web server on port 8000. 

tutorial(4): (start :port 8000)
#<wserver @ #x206929aa>
tutorial(5):

Now the web server is up and running.   Let's assume that we're running AllegroServe on a machine named test.franz.com.  If you now go to a web browser and ask for http://test.franz.com  you will contact this AllegroServe server and it will respond that whatever you asked for wasn't found on the server (since we haven't published any pages).  You can also try http://test and get the same result (although the response message will be slightly different).  If you are running the web browser on test.franz.com as well you can ask for http://localhost and get a similar "not found" response.    This demonstrates that web servers are known by many names.  If you choose to take advantage of that (creating what are known as Virtual Hosts) then AllegroServe will support you .  However if you want to create web pages that are served by whatever name can be used to reach the server, then AllegroServe will allow you to do that as well.

Type :proc to Lisp and look at which Lisp lightweight processes are running:

tutorial(6): :proc
P Dis Sec dSec Priority State Process Name, Whostate, Arrest
* 8 3 3.2 0 runnable Initial Lisp Listener
* 2 0 0.0 0 waiting Connect to Emacs daemon, waiting for input
* 1 0 0.0 0 inactive Run Bar Process
* 1 0 0.0 0 waiting Editor Server, waiting for input
* 1 0 0.0 0 waiting AllegroServe-accept-6, waiting for input
* 0 0 0.0 0 inactive 1-aserve-worker
* 0 0 0.0 0 inactive 2-aserve-worker
* 0 0 0.0 0 inactive 3-aserve-worker
* 0 0 0.0 0 inactive 4-aserve-worker
* 0 0 0.0 0 inactive 5-aserve-worker
tutorial(7):

We've emboldened the threads that are part of AllegroServe.    The thread named aserve-accept-6 is waiting for an http request.  When one arrives it passes it off to one of the aserve-worker threads and then loops back to wait for the next request.  The number of  worker threads is determined by the :listeners argument to the start function.

Publishing a file

The simplest way to publish something is to publish files stored on the disk.    Create  a file (here we called it /tmp/sample.txt) and put some words in it, and then

tutorial(30): (publish-file :path "/foo" :file "/tmp/sample.txt")
#<net.aserve::file-entity @ #x2076e0c2>
tutorial(31):

If you are running on Windows then the file will have a name like c:\tmp\sample.txt   When this file name is written in a Lisp string it would be "c:\\tmp\\sample.txt" due to the special nature of the backslash character.

Now if we ask a web browser for http://test.franz.com:8000/foo we'll see the contents of the file in the web browser.  Since we didn't specify a content-type in the call to publish-file the content-type will be determined by the "txt" file type, which is associated with the "text/plain" content-type.

Because we didn't specify a :host argument to publish-file AllegroServe will return this page to any browser regardless of the host name used to name the machine.   So AllegroServe will respond to requests for http://test.franz.com:8000/foo and http://test:8000/foo and http://localhost:8000/foo.   

If we do 

tutorial(30): (publish-file :path "/foo" :file "/tmp/sample.txt" 
                            :host "test.franz.com")
#<net.aserve::file-entity @ #x2076e0c2>
tutorial(31):

Then AllegroServe will only respond to requests for http://test.franz.com:8000/foo.   If we do

tutorial(30): (publish-file :path "/foo" :file "/tmp/sample.txt" 
                            :host ("test" "test.franz.com"))
#<net.aserve::file-entity @ #x2076e0c2>
tutorial(31):

Then AllegroServe will only respond to http://test.franz.com:8000/foo and http://test:8000/foo.    This type of restriction is useful if you want to create the illusion that a single machine is really a set of machines, each with its own set of web pages.   Suppose that the machine test.franz.com also had the name sales.franz.com.  You could publish two different ways to respond to the "/foo" url, depending on the host name specified in the request

tutorial(30): (publish-file :path "/foo" :file "/tmp/test-sample.txt" 
                            :host "test.franz.com")
#<net.aserve::file-entity @ #x2076e0c2>
tutorial(31): (publish-file :path "/foo" :file "/tmp/sales-sample.txt" 
                            :host "sales.franz.com")
#<net.aserve::file-entity @ #x2076e324>

Now you will get different results if you ask for  http://test.franz.com:8000/foo and http://sales.franz.com:8000/foo.

Publishing a computed page

The most important reason for using the AllegroServe web server is that you can compute a web page when a request comes in.   This allows your program to display the most up-to-date information on the page or tailor the page to each browser.       Using the publish function, a lisp function called a response function is associated with a url.  When a request comes in that matches that url, the response function is run and it must generate the correct response which is sent back to the browser.    The simplest response function is published here:

(publish :path "/hello"
    :content-type "text/plain"
    :function 
    #'(lambda (req ent)
          (with-http-response (req ent)
              (with-http-body (req ent)
                  (princ "Hello World!" *html-stream*)))))

 

Response functions take two arguments:  a request object and an entity object.     The request object contains all of the information about the request (such as the machine from which the request was made, and the headers passed along with the request).  The request object is also used to store information about the response that is made to the request.   The entity object contains the information passed to the publish function.  One important item in the entity is the content-type which serves as the default content-type for the response (it can be overridden by an argument to with-http-response).

A response function must use the with-http-response and with-http-body macros and then send any additional data to the stream *html-stream*.     Despite the name of the stream, the data need not always be html.     The purpose of with-http-response is to allow AllegroServe to determine how it will setup streams to respond to the request.    AllegroServe will also check to see if the browser already has an up-to-date copy of this page cached in which case it will not even run the code in the body of the with-http-response macro.   with-http-body is responsible for sending back the response code and headers,  and the body of with-http-body is where lisp code can send data which will be the body of the response. 

The preceding example sends a very simple plain text string, specifying the content-type to be "text/plain".  Typically you'll want to return an html page.  AllegroServe has a very concise macro for creating html.  Here's a response function that sends html:

(publish :path "/hello2"
    :content-type "text/html"
    :function 
    #'(lambda (req ent)
         (with-http-response (req ent)
            (with-http-body (req ent)
               (html 
                  (:html (:head (:title "Hello World Test"))
                         (:body 
                           ((:font :color "red") "Hello ")
                           ((:font :color "blue") "World!"))))))))

While both of the preceding response functions generate their response at request time, they both send back the exact same response every time.   That's not a very good demonstration of dynamic web pages.   The following page shows how you can implement a simple counter for the number of accesses:

(publish :path "/hello-count"
    :content-type "text/html"
    :function
    (let ((count 0))
      #'(lambda (req ent)
          (with-http-response (req ent)
            (with-http-body (req ent)
              (html
                (:html
                  (:head (:title "Hello Counter"))
                  (:body 
                     ((:font :color (nth (random 5)
                                     '("red" "blue" 
                                       "green" "purple" 
                                       "black")))
                       "Hello World had been called " 
                       (:princ (incf count)) 
                       " times")))))))))

This page counts the number of accesses and also displays the text in a color it selects randomly. 

 

Publishing a form

A form displays information, has places for the user to enter information, and has one or more ways for the user to signal that he is done entering information and the the form should be processed.   There may be more than one form on a web page but the forms can't be nested or overlap.

When the user clicks on the "Submit" (or equivalent) button and the form data is sent by the browser to the web server, the web server has to process that data and return a web page to display on the browser screen.  This is an important situation where using Lisp to process the form data is significantly easier than the alternatives (such as the shell, or perl or some other primitive scripting language).

There are three ways that form data is sent to the web browser

  1. query string -- the form data is appended to the url, with a question mark separating the path of the url from the form data.    This is the default way that form data is returned.  It's fine for small amounts of data, and it allows the user to bookmark the result of filling out a form.
  2. encoded in the body of the request --  If the form specifies the POST method is to be used to return the data, then the data is encoded and placed in the body of the request after the headers.   This allows the form data to be huge.
  3. multipart body -- in this scheme, the data from the web browser looks like a multipart MIME message.  This is commonly used when the form data consists of complete files, since in this case you want to pass along the name of the file (which is in the MIME header) and you don't want to pay the cost of encoding the contents of the file.

The three attributes of a :form tag that determine how data is sent to the server are:

  1. :method  -- this is either "GET" (the default) or "POST".     When "GET" is used the data will be sent as a query string.
  2. :enctype -- this is either "application/x-www-form-urlencoded" (the default)  or is "multipart/form-data" if you want the data sent as a multipart body.  The value of this attribute only matters if the :method is set to "POST".
  3. :action -- this is the url to which the request with the data is sent.    With AllegroServe it's often convenient to make this url the same as the url of the entity that created the form, and have the entity handling function determine whether it is being called to display the form or to handle the results of filling out the form.

Let's examine in detail each of the methods for sending form data:

form data in a query string

In a url like http://www.machine.com/foo/bar?name=gen&age=28 the characters after the question mark are the query-string.    The query string is not used by AllegroServe to determine the entity to handle the request.  When the entity begins processing the request it can ask for the request-query of the request object.    request-query will return an assoc list where the car   of each entry is a string (e.g. "name" in the example) and the cdr is also a string (e.g. "gen" in the example).    You can ask for the request-query of any request object and if there is no query string for the request, request-query will return nil.   

This is a typical entity handler that generates a form and handles the result of filling out the form:

(publish :path "/queryform"
    :content-type "text/html"
    :function
    #'(lambda (req ent)
       (let ((name (cdr (assoc "name" (request-query req) 
                               :test #'equal))))
         (with-http-response (req ent)
           (with-http-body (req ent)
             (if* name
               then ; form was filled out, just say name
                    (html (:html
                            (:head (:title "Hi to " (:princ-safe name)))
                            (:body "Your name is "
                                   (:b (:princ-safe name)))))
               else ; put up the form
                    (html (:html
                            (:head (:title "Tell me your name"))
                            (:body
                              ((:form :action "queryform")
                                "Your name is "
                                ((:input :type "text"
                                         :name "name"
                                         :maxlength "20"))))))))))))

In the function above we first check to see what value is associated wtih the tag "name" in the query string.   If there is a name then we know that we've been called after the form was filled out, so we process the form data, which in this case means just printing out the name.   Note that we use :princ-safe to display the name in html.   It's important to use :princ-safe instead of :princ in situations like this where we are printing a string that may contain characters special to html.      In the :action attribute for the :form we specified "queryform" instead of "/queryform" since it's best to keep all urls relative rather than absolute in order to make it possible to access the pages through a proxy server that might prepend a string to the root of the url.   We could have separated the functionality in the above example so that one entity handler put up the form  and another one processed the form.    For simple forms it just seems simpler  to do it all with one url and one entity function.

 

form data encoded in the request body

When the data from the form is very large or it's important to hide it from view in the url, the typical method to accomplish this is to specify the "POST" method for the form.   In this case the data for the form appears in the body of the request.  There are two supported encodings of the form data in the body.  In this section we'll describe how to handle  the default encoding, called: "application/x-www-form-urlencoded".  First you must call get-request-body to read and return the body of the request.   Second you must call form-urlencoded-to-query to convert the encoded body into an assoc list, where every entry is a cons consisting of a string naming the value and then the string containing the value.

The following sample shows a single entity handler function that can put up a form and can process data from the form.   It isn't necessary to use the same handler for putting up and processing the data from a form.    In this example we create a form with a big box for entering text.   We invite the user to enter text in the box and click on a button when he is finished.    At that point the entity handler gets and decodes the body of the request,  and finds the data from the text box.  It then generates a table showing how often the characters a through z are found in the text selection.

(publish :path "/charcount"
    :content-type "text/html"
    :function
    #'(lambda (req ent)
        (let* ((body (get-request-body req))
               (text (if* body
                      then (cdr (assoc "quotation"
                                  (form-urlencoded-to-query body)
                                  :test #'equal)))))
         (with-http-response (req ent)
           (with-http-body (req ent)
             (if* text
               then ; got the quotation, analyze it
                    (html 
                     (:html
                       (:head (:title "Character Counts")
                       (:body 
                         (:table
                           (do ((i #.(char-code #\a) (1+ i)))
                               ((> i #.(char-code #\z)))
                             (html (:tr
                                     (:td (:princ (code-char i)))
                                     (:td (:princ 
                                            (count (code-char i)
                                                    text)))))))))))
               else ; ask for quotation
                    (html
                      (:html
                         (:head (:title "quote character counter")
                         (:body 
                            ((:form :action "charcount"
                                    :method "POST")
                              "Enter your favorite quote "
                              :br
                              ((:textarea
                                  :name "quotation"
                                  :rows 30
                                  :cols 50))
                              :br
                              ((:input :type "submit"
                                  :name "submit"
                                  :value "count it")))))))))))))

In this example we ask for the body of the request and then the value of the field named "quotation".  If that isn't found then we assume that we are being called to display the form.   We could have checked the value of (request-method req) which will be :get when we should put up the form and :post when we should analyze data from the form.

 

form data encoded as a multipart body

The final method of sending form data is as a multipart message.   This occurs when you specify a :method of "POST" and an :enctype of "multipart/form-data".    The handler for this must detect when it is being called from a :post request and must call a sequence of functions to retrieve each item from the message body.  First it calls get-multipart-header to get the next header (or nil if there are no more headers).     The header data is an assoc list where the values have different formats as described in the AllegroServe manual.  After reading the header  the handler must call get-multipart-sequence to read successive chunks of data associated with this header.

An example demonstrating this is too large to include here but can be found in the AllegroServe examples.cl file (search in that file for  "getfile-got")

Authorizing a request

You don't necessarily want to allow everyone to access every page you publish.    We will describe common ways to check whether someone has permission to access a page.   There are two ways to do the authorization checks.  You can write the tests yourself in the entity function, or you can create an authorizer object and attach it to the entity.    Below we'll show you how to write the code to do the checks manually.   The Allegro AllegroServe manual describes the authorizer objects.

password

One way to control access to a page is to request that the person at the browser enter a name and password.   You can create a form and have the user enter the information and then click on a button to submit it.   Another way is to return a 401 (response unauthorized) code to the request made to access your page.    When given that response, the web browser will pop up a window requesting a name and password, and after that's entered, the browser resends the request but includes the name and password in the header.

The method you choose for asking for the name and password may depend on how secure you want the response to be.  Using a form the name and password are sent to the web server without any encoding at all (other than the simple urlencoding which only affects unusual characters).   If your form uses the "GET" method then the name and password appear in the url which makes them very easy to spot, so you at least want to use the "POST" method if you use a form.    If on the other hand you use the 401 response code, then the name and password are sent in a more encrypted form (using an encoding called base64) however anyone sufficiently motivated can decrypt this without a lot of trouble.   AllegroServe does not yet support md5 authentication which is the most secure way to do authentication in the HTTP/1.1 protocol.

One advantage of using the 401 response to cause the user to enter a name and password is that most web browsers will continue to send the entered name and password along with future requests to the server until the web browser is restarted.   Thus you can simultaneously unlock a whole group of pages.  If you choose to handle the authentication in a form you may want to use a cookie to make a record that this web browser is now qualified to access a certain group of pages.  Cookies aren't hard to store, but some users turn off cookie saving thus you will  make your site inaccessible to these people.  Another authorization mechanism is to insert hidden fields in forms with values that tell the server that this access is authorized for a certain amount of time.

This is an example of using the 401 response to do user authorization.   

(publish :path "/secret"
    :content-type "text/html"
    :function
    #'(lambda (req ent)
         (multiple-value-bind (name password) (get-basic-authorization req)
            (if* (and (equal name "foo") (equal password "bar"))
               then (with-http-response (req ent)
                      (with-http-body (req ent)
                        (html (:head (:title "Secret page"))
                              (:body "You made it to the secret page"))))
               else ; cause browser to ask name and password
                    (with-http-response (req ent :response 
                                                 *response-unauthorized*)
                      (set-basic-authorization req "secretserver")
                      (with-http-body (req ent)))))))

 

source address

You can determine the address from which a request was made and restrict access based on that address.    If the request came through a proxy server then you are really determining the address of the proxy server.  The following code only serves the 'secret' page if the request came from a browser running on the same machine as the server, and which is made over the loopback network on the machine.   The loopback network is a network that exists entirely inside the operating system of the machine.  The convention is that a loopback network address has 127 in the most significant byte, and that is what we test for in the following example:

(publish :path "/local-secret"
    :content-type "text/html"
    :function
    #'(lambda (req ent)
    (let ((net-address (ash (socket:remote-host
                              (request-socket req))
                            -24)))
       (if* (equal net-address 127)
          then (with-http-response (req ent)
                 (with-http-body (req ent)
                   (html (:head (:title "Secret page"))
                     (:body (:b "Congratulations. ")
                        "You are on the local network"))))
          else
               (with-http-response (req ent)
                 (with-http-body (req ent)
                   (html
                     (:html (:head (:title "Unauthorized"))
                            (:body 
                                "You cannot access this page "
                                "from your location")))))))))

To see how this example works differently depending on whether the access is through the loopback network or the regular network, try accessing it via http://localhost:8000/local-secret and http://test.franz.com:8000/local-secret   (where we are assuming that you are running on test-franz.com).

Multiple servers

AllegroServe can run multiple independent web servers.  Each web server listens for requests on a different port.  Because each web server can appear to be serving pages for different hosts (using the virtual host facility already described in the discussion of the publish functions), it is usually not necessary to use the multiple server facility we describe here. 

All of the information about a web server, including the entities it serves, are stored in a wserver object.     The current wserver object is stored in the variable *wserver*.    The publish functions use the value of *wserver* as the default server into which they publish entities.

 

Debugging a computed response handler

We will describe this in detail when the tutorial is updated.  For now read the documentation on net.aserve::debug-on in the AllegroServe manual.

 

 

 

 

cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/example.cl000066400000000000000000000455121133377100500232750ustar00rootroot00000000000000;;;; AllegroServe Example (defpackage "ASERVE-EXAMPLE" (:use #:COMMON-LISP #:ACL-COMPAT.EXCL #:NET.HTML.GENERATOR #:NET.ASERVE) (:export #:start-server #:stop-server #:start-simple-server)) (in-package :aserve-example) (defparameter *hit-counter* 0) (publish :path "/" :content-type "text/html" :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Welcome to Portable AllegroServe on " (:princ (lisp-implementation-type)))) (:body (:center ((:img :src "aservelogo.gif"))) (:h1 "Welcome to Portable AllegroServe on " (:princ (lisp-implementation-type))) (:p "These links show off some of Portable AllegroServe's capabilities. ") (:i "This server's host name is " (:princ-safe (header-slot-value req :host))) #+unix (:i ", running on process " (:princ (net.aserve::getpid))) :br (:princ (incf *hit-counter*)) " hits" :p (:b "Sample pages") :br ((:a :href "apropos") "Apropos") :br ((:a :href "pic") "Sample jpeg") :br ((:a :href "pic-redirect") "Redirect to previous picture") :br ((:a :href "pic-gen") "generated jpeg") "- hit reload to switch images" :br ((:a :href "cookietest") "test cookies") :br ((:a :href "secret") "Test manual authorization") " (name: " (:b "foo") ", password: " (:b "bar") ")" :br ((:a :href "secret-auth") "Test automatic authorization") " (name: " (:b "foo2") " password: " (:b "bar2") ")" :br ((:a :href "local-secret") "Test source based authorization") " This will only work if you can use " "http:://localhost ... to reach this page" ;: :br ((:a :href "local-secret-auth") "Like the preceding but uses authorizer objects") :br ((:a :href "timeout") "Test timeout") :br ((:a :href "getfile") "Client to server file transfer") :br ((:a :href "missing-link") "Missing Link") " should get an error when clicked" ) ))))) ;; a very simple page. This is so simple it doesn't put out the required ;; tags (like ) yet I suspect that most browsers will display it ;; correctly regardless. (publish :path "/hello" :content-type "text/html" :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html "Hello World!"))))) ;; this is the "/hello" example above modified to put out the correct ;; html tags around the page. (publish :path "/hello2" :content-type "text/html" :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:body "Hello World!"))))))) ;; display a picture from a file. (publish-file :path "/pic" :file "ASERVE:examples;prfile9.jpg" :content-type "image/jpeg") (publish-file :path "/aservelogo.gif" :file "ASERVE:examples;aservelogo.gif" :content-type "image/gif") (publish :path "/pic-gen" :content-type "image/jpeg" :function (let ((selector 0)) ; chose one of two pictures #'(lambda (req ent) (with-http-response (req ent :format :binary) (with-http-body (req ent) ; here is where you would generate the picture. ; we're just reading it from a file in this example (let ((stream (request-reply-stream req))) (with-open-file (p (nth selector `("ASERVE:examples;prfile9.jpg" "ASERVE:examples;fresh.jpg")) :element-type '(unsigned-byte 8)) (setq selector (mod (1+ selector) 2)) (loop for val = (read-byte p nil nil) while val do (write-byte val stream))))))))) (publish :path "/pic-redirect" :content-type "text/html" :function #'(lambda (req ent) (with-http-response (req ent :response *response-moved-permanently*) (setf (reply-header-slot-value req :location) "pic") (with-http-body (req ent) ;; this is optional and most likely unnecessary since most ;; browsers understand the redirect response (html (:html (:head (:title "Object Moved")) (:body (:h1 "Object Moved") "The picture you're looking for is now at " ((:a :href "pic") "This location")))))))) (publish :path "/tform" :content-type "text/html" :function (let ((name "unknown")) #'(lambda (req ent) (let ((body (get-request-body req))) (format t "got body ~s~%" body) (let ((gotname (assoc "username" (form-urlencoded-to-query body) :test #'equal))) (when gotname (setq name (cdr gotname))))) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "test form")) (:body "Hello " (:princ-safe name) ", " "Enter your name: " ((:form :action "/tform" :method "post") ((:input :type "text" :maxlength 10 :size 10 :name "username")))))))))) ;; example of a form that uses that 'get' method ;; (publish :path "/apropos" :content-type "text/html" :function #'(lambda (req ent) (let ((lookup (assoc "symbol" (request-query req) :test #'equal))) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Allegro Apropos")) ((:body :background "aserveweb/fresh.jpg") "New Apropos of " ((:form :action "apropos" :method "get") ((:input :type "text" :maxlength 40 :size 20 :name "symbol"))) :p (if lookup (let ((ans (apropos-list (cdr lookup)))) (html :hr (:b "Apropos") " of " (:princ-safe (cdr lookup)) :br :br) (if (null ans) (html "No Match Found") (macrolet ((my-td (str) `(html ((:td :bgcolor "blue") ((:font :color "white" :size "+1") (:b ,str)))))) (html ((:table :bgcolor "silver" :bordercolor "blue" :border 3 :cellpadding 3) (:tr (my-td "Symbol") (my-td "boundp") (my-td "fboundp")) (dolist (val ans) (html (:tr (:td (:prin1-safe val)) (:td (:prin1 (and (boundp val) t))) (:td (:prin1 (and (fboundp val) t)))) :newline))))))) (html "Enter name and type enter"))) :newline)))))) ;; a preloaded picture file (publish-file :path "/aserveweb/fresh.jpg" :file "ASERVE:examples;fresh.jpg" :content-type "image/jpeg" :preload t) ;; a preloaded text file (publish-file :path "/foo" :file "ASERVE:examples;foo.txt" :content-type "text/plain" :preload t) (publish-file :path "/foo.txt" :file "ASERVE:examples;foo.txt" :content-type "text/plain" :preload nil) ;; some entries for benchmarking (publish-file :path "/file2000" :file "ASERVE:examples;file2000.txt" :content-type "text/plain" :preload nil) (publish-file :path "/file2000-preload" :file "ASERVE:examples;file2000.txt" :content-type "text/plain" :preload t) (publish :path "/dynamic-page" :content-type "text/plain" :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html "This is a dynamic page"))))) ;; an example which causes the web browser to put up the ;; name/password box and if you enter the name "foo" and password "bar" ;; then you get access to the secret info. (publish :path "/secret" :content-type "text/html" :function #'(lambda (req ent) (multiple-value-bind (name password) (get-basic-authorization req) (if (and (string= name "foo") (string= password "bar")) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Secret page")) (:body "You made it to the secret page")))) (with-http-response (req ent :response *response-unauthorized*) (set-basic-authorization req "secretserver") (with-http-body (req ent))))))) (publish :path "/local-secret" :content-type "text/html" :function #'(lambda (req ent) (let ((net-address (ash (acl-socket:remote-host (request-socket req)) -24))) (if (equal net-address 127) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Secret page")) (:body (:b "Congratulations. ") "You are on the local network")))) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head (:title "Unauthorized")) (:body "You cannot access this page " "from your location"))))))))) (publish :path "/local-secret-auth" :content-type "text/html" :authorizer (make-instance 'location-authorizer :patterns '((:accept "127.0.0.0" 8) (:accept "tiger.franz.com") :deny)) :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Secret page")) (:body (:b "Congratulations. ") "You made it to the secret page")))))) ;; these two urls show how to transfer a user-selected file from ;; the client browser to the server. ;; ;; We use two urls (/getfile to put up the form and /getfile-post to ;; handle the post action of the form). We could have done it all ;; with one url but since there's a lot of code it helps in the ;; presentation to separate the two. ;; (publish :path "/getfile" :content-type "text/html; charset=utf-8" :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:head "get file") (:body ((:form :enctype "multipart/form-data" :method "post" :action "getfile-got") "Let me know what file to grab" :br ((:input :type "file" :name "thefile" :value "*.txt")) :br ((:input :type "text" :name "textthing")) "Enter some text" :br ((:input :type "checkbox" :name "checkone")) "check box one" :br ((:input :type "checkbox" :name "checktwo")) "check box two" :br ((:input :type "submit"))))))))) (publish :path "/secret-auth" :content-type "text/html" :authorizer (make-instance 'password-authorizer :allowed '(("foo2" . "bar2") ("foo3" . "bar3") ) :realm "SecretAuth") :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Secret page")) (:body "You made it to the secret page")))))) ;; this called with the file from (publish :path "/getfile-got" :content-type "text/html; charset=utf-8" :function #'(lambda (req ent) (with-http-response (req ent) (let (files-written text-strings) (loop for h = (get-multipart-header req) while h ;; we can get the filename from the header if ;; it was an item. If there is ;; no filename, we just create one. do (let ((cd (assoc :content-disposition h :test #'eq)) (filename) (sep)) (when (and cd (consp (cadr cd))) (setq filename (cdr (assoc "filename" (cddr (cadr cd)) :test #'equalp))) (when filename ;; locate the part of the filename after ;; the last directory separator. the ;; common lisp pathname functions are no ;; help since the filename syntax may be ;; foreign to the OS on which the server ;; is running. (setq sep (max (or (position #\/ filename :from-end t) -1) (or (position #\\ filename :from-end t) -1))) (setq filename (subseq filename (1+ sep) (length filename))))) (if filename (progn (push filename files-written) (with-open-file (pp filename :direction :output :if-exists :supersede :element-type '(unsigned-byte 8)) (format t "writing file ~s~%" filename) (let ((buffer (make-array 4096 :element-type '(unsigned-byte 8)))) ;; note: we could also use ;; get-all-multipart-data here (loop for count = (get-multipart-sequence req buffer) while count do (write-sequence buffer pp :end count))))) ;; no filename, just grab as a text string (let ((buffer (make-string 1024))) (loop for count = (get-multipart-sequence req buffer :external-format :utf8-base) while count do (push (subseq buffer 0 count) text-strings)))))) ;; now send back a response for the browser (with-http-body (req ent :external-format :utf8-base) (html (:html (:head (:title "form example")) (:body "-- processed the form, files written --" (dolist (file (nreverse files-written)) (html :br "file: " (:b (:prin1-safe file)))) :br "-- Non-file items Returned: -- " :br (dolist (ts (reverse text-strings)) (html (:princ-safe ts) :br)))))))))) (publish :path "/cookietest" :content-type "text/html" :function #'(lambda (req ent) (with-http-response (req ent) (set-cookie-header req :name "froba" :value "vala" :path "/" :expires :never) (set-cookie-header req :name "frob2" :value "val2" :path "/" :expires :never) (set-cookie-header req :name "frob3-loooooooooooooong" :value "val3-loooooooooooooong" :path "/" :expires :never) (set-cookie-header req :name "the time" :value (net.aserve::universal-time-to-date (get-universal-time)) :path "/cookieverify" :expires (+ (get-universal-time) (* 20 60) ; 20 mins ) ) (with-http-body (req ent) (html (:head (:title "Cookie Test")) (:body "you should have a cookie now." " Go " ((:a :href "cookieverify") "here") " to see if they were saved")))))) (publish :path "/cookieverify" :content-type "text/html" :function #'(lambda (req ent) (let ((cookie-info (get-cookie-values req))) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Cookie results")) (:body "The following cookies were returned: " (:prin1-safe cookie-info)))))))) (publish :path "/timeout" :content-type "text/html" :function #'(lambda (req ent) ;; do nothing interesting so that the timeout will ;; occur (with-http-response (req ent :timeout 15) (loop (sleep 5))))) (publish :path "/long-slow" :content-type "text/plain" :function #'(lambda (req ent) ;; chew up cpu time in a look that blocks ;; the scheduler from running so this aserve ;; won't accept any more connections and we can ;; demo the multiple process version ; takes 50 secs on a 1.2ghz Athlon (locally (declare (optimize (speed 3) (safety 0))) (dotimes (aa 500) (declare (fixnum aa)) (dotimes (j 300) (declare (fixnum j)) (dotimes (i 10000) (declare (fixnum i)) (let ((k (+ i j))) (declare (fixnum k)) (setf k (- i j)) (setf k (+ i j k)) (setf k (- i j k))))))) (with-http-response (req ent) (with-http-body (req ent) (html "done"))))) (defun start-server (&rest args &key (port 2001) &allow-other-keys) (apply #'net.aserve:start :port port args)) (defun stop-server () (net.aserve:shutdown)) (defun start-simple-server (&key (port 2001)) (net.aserve:start :port port :chunking nil :keep-alive nil :listeners 0)) #| (in-package :aserve-example) (use-package :net.aserve.client) (setq cookies (make-instance 'cookie-jar)) (do-http-request "http://www.dataheaven.de/" :cookies cookies :protocol :http/1.0) (net.aserve.client::cookie-jar-items cookies) |# cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/000077500000000000000000000000001133377100500231315ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/.pics/000077500000000000000000000000001133377100500241455ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/.pics/med/000077500000000000000000000000001133377100500247125ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/.pics/med/Marble01.jpg000066400000000000000000000107521133377100500267640ustar00rootroot00000000000000‰PNG  IHDR@@% 扱IDATxœešO‹$I’åhÂSð5Ȩ†Îcç»îu¿AŸ–¾Ö¦Û‡…¾MÔPPI›BèƒÔÃDÔ̳62 ‚wsUùóäÉùðÛÿþ ÚTäiçÀf ¤‚§uÛ *x"p!_/1¡È¶ ö.ª BÆ"_ãiÓ˜žCTÏÃ* FA`P©ë³†¨0( ÿN?îÃÔ›TôäÃxx_Û¸{v¤óôë³åé87àé¼'ÕsÆäkðÌ×öÈ'”j†ŠÈÿV©.UŠß³ž3(ë™Ó†î S%Š >©µýë»ÊFAmCME>:†åP=-Dž}w¾6^öLì¡9ì¡óôù}Yµ(îã‰Jx»¢æoÂvñä8½J¥ðäé*½þú ¶Ë6ƒT]P»˜Þw÷cgÚs‡ðØ`áðñtFþ<‡8ýÎÄ+ä9DÍû€ˆ¸ªž»ŠLÚ➧ÃöÎÏ(؃9ždÛË}ß;‡™Ï6mH¨ÛŠA@SƬø!N,*Ër¤ýðÑ9<ú3bì1Ö­"hç€j[fÜ*½”ÏŸ`*j¦Ýû‡ßþõ¯” ÃÝL·O/.™CÌjï×'Tâd^žÙ¼~§7CàÃàýµT ümk×"fžœŒΈR‰ŒgVÏÁ$þ2p]V$}øçßÿÍi­Þ íþb dÄ9ttM\Pæ´2ׯ9yEsx]e›ßw)A ¨>kªÅ —ê¹kÊXÚÌкØ®qG…í6 Oqƒ´ù&&>væŠé9IŠö鈄8 e¡^AÚâØûaºGö˜=üF}Ãîñ~FàFp*Ý6 U¢mÜ6¿÷ôU‰8B¼F ísckíO_ ¼Ûû0&Ì•“˜¢¨€O™Á‰'Qÿ«‹T„½üU"¯5_趥ýlfð"¼Ÿ9\ë)!9°œ+K4ÉzNbÎb‹»:ýSuU™:vFQbk­vá­lHÛ§ÆÖjaô·zx{…:©Eo%+n gp^$â¶3Î*&%¸d7‹iÑQe±]‘ 0¥.®æDÛ²XʲÒB2¨6#ŽW¿w}¾F /‰QT§ÆþÆ;Ô¦›2'7{Í Þ*ãiÃÄÅB~ûûO«2Èñõµª½w¦\âþ$‹,'‹zs}jf›ydï݇õ§»nbRKfòeãéa×o¢5D»mŽ“åÿ{&ž’JÎuú•ÝgŦÈǶŸuqqôDe «º )ëeØ/>ïYÌÁ¯?sôŠ™×é“ÇF…ùhnM7é¶üt±Äɳǘ~ –«²]1­+¾)¾p¼i²*ÀH\*Áæ#›7 ›6 µTŠjQ-Ô¢kAÑ÷¸³÷1!¸ñáñû[í}½7釻nB[Åì=²'±N~~ìš0Ç“ H λ’ÿY´B-»D€³ºÕ‘dïgF-õŒòˆ &Ãwº½ô¯¯Ø»ÍÑýû+5¤Ú7éÖ’iÍlïšÃÞñð±ãµr}*õÃo']Œ?jûÙ[`ãa;=£i‹«›ÉÎ5yøðžœy¥Äþû«n›'þúªûÜsûÜ,e¦Ê­Ü›Ï ÌáÊóûSöòä÷Œ­ÂÕYõùp±‰½oÔ—+7†÷ô@ÉøÞG_ȘcÔgm/wKg}tþ9ynÄ$EÉáãçÀF®;üÑZ<2-¬ø!=£‡ž쌷è\'ý.ü6ïÝÇ@YIêË]í̺ůÊê%Î'—¸óÕgž}Súº,MófZå{Öo’±F-ÜU”^>»Ä¥ Œ¨¦~€ÞwÖ'^þô‘w"DÆŒóÜa ¯ÿT7:§Å\ˆÅï®ú:iNʲÐHŸ5xUq-–‘¸~ußòÞ1퇗—/_Pr;%F“O;5yžÕi…MY=É©’:Øè´§3ÌÞg_–:GMáBR˜CÛu2¢ëï{÷Û+Ÿ6m²býŒÅ‚a¬ðêûV\ÊÒà± àIÀÜÏŒL®—Ú*U«úf•ˆhQU9Y™ßeE…äoÖ°ë¿üLkís«’²|ˆïˆ)àáú”"¹„ÿ¶³bˆÊO×mæpÅ»½§OÂös©ZúŒ=Θ±¹úñ•—òî·×þ_¯t«‰'+ÿ"¹Ï\\üqòXÖqÚ”S±ã:U}’6¨É“¢fÍÕ-‹9ǹ—nó ´­îd"*vô¯Ývûáå~ÿ¢d)Ï}øÞãKvvÊXøAb¨B}ѦR¥üo(œ·¿¿PÎö³?Ì{ƒ ƒ ݉ª™ÙæðÑÇÞíùJÑî®±25»g£U‰XŠSè(¥.U8sTg&Ä­œ˜›}|áÃoÿþ_ó±»]YùpqÕÁ÷¥Q7G­í½~3ÏwÝò¾ž†÷·úùŽ¶,å aVÈžN“ÊÒ#'8¿òV‹íG°”UAþ6—>ï×êã³CCŸCSýèãÝÐñàV·­¡,…Ê¢Ag2Ž¾)ìZ/Û?ò‚ìWÖfĆ:NxeѺã©E¦6¦ÛŠÔ Z5oåß©¡ïG÷ï{ÿúvÿÔêçM·» )PõV™£Ò˜Œa>²b£±ª©éy]¶N ï²yջŗŠŸYèÕ¹_qöȳþ ¿þú³ßÞTøòãj‚{×­yZeƒ±8ßFÙÕ¥st}º›PÌÏ©Bä÷ªYÉUb±àS©f©ùš-mçdù'ÏyÐj‚;T{½¿ýã‚ûŸïÛË/•3ÔOµ–3•Ð}´1­RÝ_yï>zk/gÕײ¥¿ãËÆátò4ιÄRç?üçß~ÒÅÛ²FdïK }Š£{ßíVõ,â‰z˜2…vÛ;­%Gµba¡n=²µ—ï´n;x˜é´}ä‰Ç~PÐTøðÛß~ZYÿ ÚØcï34yû¯·ÿåG>µàX(kaf¼MLt&ÜZ»U¯Ã)53³âÛÓjÛö€E'2^ýîÅ‘æ#—†Yª¡¬7â»óÞÇÛóf¨ŸEu²ÿúsû¡ñ©¡Í "(›mT=GÆt°Cz>9lY= ÍehÚ_»&nR©Á+/{ó€Q'ØñªÜá•Z8ú°Ù÷q«Ûvçåõøê{W©õËR‡[½Ø4½<Î#V6$WOe¡Íê‰Zsï­Ü¹¸ôý2S£î‰4jÉFÎÄ~+ã½3©[Õ§?{±E¡œ[{g“n;¿ªãY›©—Ž4íþ*½¬."ãáB T#õ£·R]BóY–åŒt[ìúèœul„M&ukjRÛY7¼ÛðÒî‹9?ÔäB»{Vä‚&;³œÀÊÕ0‡Êæù°'o_¹Ç»ù 43»A? ɘ£ÔÏ-^÷Ý<8•]1Þ¶g|nõAÑ7zŸÔékL–b†. /§AÊFX—ý‰9T؇)¼Ãõ£(ès»0*µ{zVåÅ5nwÛÕ*úôÂc”êM˜Ìî£>kõ\ë¯KMYÚrÚxصhØuzŸ®E6L£¼³ö°bhÆîmk†ºÅ´ï²Wv˜T<Κó%ïº5Z¤á¥°û»¹¬ Ö­­œÎß?0D×SO¶+ìG×»_½iÛýšUûu²WRǦP·Æ­m§~33 (¬ ƒUËJ]‘êÎXg-yãÅ–X*€¨ûì[[ˆ”Y˜}ЉûtEÃÔ°õúÚ{—"+*Re˜ÏÚžïÆU Κ•yæDN¬ïô牳n*óÇßþþSÆσ²ÂÄÇàèû¯?¿üøc0¬…Ð]æMün=«~×$KYóƒŠÙ«±=²éš­<Øh¤î{uQ9§óšÃfbyà¬Õ犺Ídÿ½o·‰óÐì±ï·º}¾ŸO®åä›Qk²_ÙJ³/6š;.ó¡ZeeõŠ™‡n{&[ËHË×`8u¡U;rFϘ]ŒA]K¯¯§È5´±m©B/^”^þƒúçΔÉ¡­?¨—ç\K{¨‘ìsÔ‚MêË<ò9¤ÂS¢Êª x0« "J­UãÝ><^_齪ÖÛVoÛöù^oªjõD§¥7¥êèKUÖšÓ¤TzîS”9t¼ &TÃ^xˆ¨“;¥ŸÇ‡ßþþÓÕïgŒ¼ùÚ÷×W@7ÕçíT'OŪJ£œ1“螟·u¾~=ßjð9^ç–‹c*\s=ö`NECÜPÙÊÉò|ä+5|XŸ¶í¹EFzZ¥eØõÖ2âË©ÏÅ®RêÌfˆÍsDOØ2+Ø_ßê–Xi÷hÖ˜ö1ÒÞ±Ð^x–BÓ?‘‡!m>Ó`Í͸ôcm˜ñÞã¦Û³|ÓvN‡ŽÎdÿöKý»«ó8q0û½…ƒ¬y=Õ V/ Ô*ÜìÇ. PUyVÝZ¾Âæ›™CSv‡G~°žæ5Ï.|øÏÿõìñÞûÛÏ/÷/<+•©«›6ï ï¨RS·˜7Æœøaãfqz®ÚtuèMú±Ë Š¯jZÝ9!€3‡‹§4OøÿólŸÛê‰×¹/Tõ…÷£G¼mÏ Á­Qª¤ÇŽö¬$ W·}vUÇØýe{¹?Þ…¡œ[~óÜ÷áòÌ´ÏÙÔ¾Sj-*ÛÖ¸©­s3iª&£¶Q=á68\uç–DÔÈ¥Tç{WbÙXE.£nb:¦Iíì­ b3Î~?pyÍì‘q1qÐÕÈòé'š¸ºÄJÌû¿Ó) TµÔnɺ˜ƒé³’xfí²?î+ž›ªÜÚb_5³9´½¾½”Ÿ5 »méó›¸5Dý¼ ¬­=q²ÖP²Ö¹³¼éd¶Ñ­W5Š¤Šjön3u5®ý¤ÌìkºxâýÚR;§tW†,6™™³v²Vn§ç·­éÖêç» O„§ Wv¢•‘‘%¢ÙuíD$„ÍJîx@l{9ûìljò*çÌä<?Ó0<\Û™\}ß¾b²®ùÝ5yb^¹¢¥—(£6÷ ³B—Þ²¾<ìS¤b‹e[){†—ÒqVºÌŠµ…‘{¡l/ =9ïBç…ÔCEÊ‹TŸr~æܸÕC¼^Ì4À§nÃ|À–Äœ8Þ¸²™‹Y°Ì‘DLÿO”,—ÕÿàŸ]kêªßœûB8,=R×N;5Ew/ ¨µTÛ-æ JàâB§ýˆ<íq“tm‹Å‚.‹<îœfMHŸ¾óÃpoú ±âa&åž o®yL-»ž;v×Vnì&{Å´Ãoݱ¹v³'ž6;ß9“Uöq»º¿3–rcÍu>üóo]Õ•˜ÇlëVhŽDUëԩ맊q¿¯Žâœ-¬}ÖœáT]'ûáèÇR}`Õ²µž³°@[ÖdhŽÅj3V‰í7¥Š‘÷žxR–êXîÜŒÏS¥DU©‹?oæÔ>d¨Š®#Ùèš3xØ»¶÷&vx¯ÿ }eˆM×"IEND®B`‚cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/.pics/med/aservelogo.gif000066400000000000000000000042471133377100500275560ustar00rootroot00000000000000‰PNG  IHDR@Ì ‰ênIDATxœÍ™mhÇÇ +˜ ì‚·E]‘Á'lð"‘@tÔË™|°œ~p„J‰ý!µB q>„:¹ˆÜd¨cjçjç\H9œZ!Šï 6^A„öˆíš¡Z˜~˜Ó›í …žLÿ°<{»óò¼Íÿ™Ù{ÄcøÂrâA`Àœ^ðŠMŸª<]æѦú¿`qU;€joefÛ¦t6üŠ†Ð€Ø\&!8µ5‰h\BI€lý7´t"—‹P;€tñÆvØÜã€Ò­Aü6E&í­Yü2"ÿ”Gñ«ˆ|×ÚsÐÐ"`ha‹r]û,ú4ª>Žt?–Nû¼%"߸ïÜã0 ,-“}á¦yåÍ9³}GïZùú]³´d¶sÆÌ cr÷¿ú¾Ý˜ÿ|¾“cŒ¹ùÍM³šW"öû¿Š‰"ð<û\% H”‚ñKa¤éïõéÜa_ߘV®izr¥áÀ3’O¿Phâ:~ÞãüeÅT%&ÿ¤K¾[ÚŽÑ1p48ý#£Îc³¬{û¢k$8qUÓ¿Ïãð~—ñÉh­EÃEÂÀË'Búº}Žÿ1 |Êû JþIÁùË1o}ðç³U ×4~«àÔ™ˆ‰«1ýû|N_¨2vQ!$–íWÒ}²Ü€ÜFóC(MGTî(tc—b»6Á MPƒJᶠ‚jD¶CpæbHájÄáý.=9ÉÉ_û±¦ôðQŸ|·düJÈØÛ>{³pêõ £ª ÆP‰¶NÖ¥{T“Ðâo«ñ«›ŒÈç<¦nÇDó€7î4ÔpÆ8ŠıFkA6#èïõ‰ëÚfà¥Ø@­¾Û¸Iä*ù¹â:  –å@‡ù ,Ãr°½V¯Ã£g.ÆŒ¼ésò5ŸáבJ@RÝXï™AÕß…xïCs£Ñ<ô÷ŠUÒèî’¸Ž@)ÈwÙvïqÁâŸ:9þAÀÁ7Bª±æàÓ{³ðÊói^þ½UZ¤ãì«Q9ž¡4¥9øFHPÕœzݦ÷Jl”1$EX†O¿PŒ^Œlfá<ܨ(ÎO*ÊE®é]š²Ë5Š`lRqþ²u8Ë–¼W—õz4£œ|^Z2ï|8g––Œ¹TZ0ý¿Û¼“1Æ,˜¥9Œùžû¤ùác3p|μóáœù¤°dzÜ5ssÆ|ô·“}á®ùÃ蜹ô%3ð¦-Ó ?“{é®YX0¦û—wÍG_0#c ¶|ÿ`ÌÇû{dlM·›ßÜ4MÙ ç»$$‚—O\ýB3r|‹ä%‡­7A¼ƒt²2!¬÷P™Õôuûøm6Ç&#„#zÑåØ+>öI*36²…+Ϲþ¥ÈíäÚ=r»$‚ʬ¢g—G.+ÈfÜ *8Òë'£†_óoÓ¦–LmßN{=6ó?G%1ÒÉ̦ыU ×B@€£Éîp©V5éÇ׶Ó}O Æ>‹8}1äü{Œž ™™Õ«ýº÷€’Ìyâþ’úðCËE˜ÐÖÖ„Í€Ô=»$ zÉgøWþã.Rhôj¯Áý>ïŸñ„‡ÿ8ä»-W ñ>â××U¢ 9°Ëز¶e‡{ÿúèý›€å2£H#å#¿Ëpà7e¼”$íÂÀs¢X㉵3E&ÙvÁÀ>›=9Iï´KÏ«ž€Þ®/1¦‰ßæ#¸UA}WAJ d{:2ð˜(ó?÷ShéYgmY¸^7ƒœ P·û­Ñvn ´un,»› 9epøªˆr¨Eȶ>ØÙ u…ú²ÐêA=‚é*ìHCJ"u»=¦f·ؽj¸>TÊ°£å”AˆŽ5¢; •êžÐ6óª‘ÝNwåÁÛ –§ËMÜD ªÏ*´¢Ã¢‚™âئg«oKŸ´¦m›ÙÀfDBCjpÜÆ·Wm/!Àuíøõ†C„°k>Ží¸éô–o¾6ý_ƒìýf²‰x¸Œl¦|Ëe“ñ_%£*†å?£`IEND®B`‚cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/.pics/med/fresh.jpg000066400000000000000000000064121133377100500265260ustar00rootroot00000000000000‰PNG  IHDR@0.)ëH ÑIDATxœ}šO‹$É‘ÅSxÃ3HŒ  tiØïÿ-voÒaatš‹ØªCƒ;L€?h?ìÁÜ#²º…’&:+22ÂÜþ<{ö<ùíþ›iŠÖ(Q4¦£hà(T3Dx3à;e{Žñéèà)û•×TŠ£T¦£dŽeå•ÃÓ<Ç¡ #¯‰ôIG‰Á8 Ù*«`[E&(ŸöÂÞÏ!è{µ=«±Œ¦#3~—Gæ@®ëŽ%F¢ Zµ˜¾7Ëz Ù+÷´óG5«Ù«ê€U{ž2d| Ê»MºG­¡?ÇÛŸC5j•*o5ôà8â…+ËÓúõ^™Á—õ0â©N®¸QV|Ì‘õpè[ AÆíªQP©O>Ê3‡€È+«‚/ xâ ñ¾+m§CudV|a(ÓHN˦QóE #½ÿë÷vš óªÂZ+p(ìÌû¼çPÑ`D ϸý±êr‚êe}â5 žOU…çW‰«æu…ÌŸ…ºqÄw1²ÚPQ?ß!<[úl÷ðš´9¢„í ˜èqxú;’’ú·×zP–ˆðd!Àg‹x½ í½ŽÏHeíÌÎþÀ¼Ö®fÛîý‰çBÚyU´º„²‹ ©¦G‘TªAº¢„²ZþDñ'âOÚÖÿçh!c•$Ux®]®ŒdcΊä>3 (ÔG¤óÒ÷Ù1 ‰H¸K¨ ŵÀ´Šg]ÚŒ±3ˆÊ9óSV¤|Û”h0±Hî°"Pv¾gƒ1`D?‡ÏÑ=@‰›^ÝÚìløTÁPî‹‘HÆ`0Úø±o}ÿ1 /*±Ð·ŒËÓ7`Ÿgu&|I´©R\ìh_o•ÐzŸÞI X÷dÚÓ€¯êŸèQm<¦mÌÈ(÷þþ‰ýD^ÌPÞ‹XY»|¿`ØÝڛрvv;íÓZÈŒ]ñ™Äá9(¬»i¯M 7)!ˆãÚxYyO"Ì…V‹¯—0ãâÆx±àÅÆ&ÊuB­GÞì‰Ò{çtï-'Šœ4ò¥ŒZh®XMÚ9öûÑ<”ŸöùQ”#;Ëâ mv™HŸðS=í©íxÔH›ìÄÄvö~6Ûí윽Dáõõ-3s`‰«Æ’l㑼Èn@·™|ôn;ã‚OSp1xœWžúëÅÑWÏ*;>?—Ý0ì$mîãýã}t÷oïý[ûøhîÞXL”z}WÓ‰¤u÷ÇîàÛUÙUµ*»ànå&còûÇÇUÛÓsÕƒ½ëureÌmýN¦××£þzÙfsæôëXU4T¨yËàxÚ½÷Þ|úznz:k`Y²ýHÔ‡²f$$<{0yY=ŸÍ™³Ãßsê¶t1„Ϩ\…£ÐÎ…¶»~öŒ±×€í9ú9ú·–cÃû·÷•?™&ýìžØöiOò“~®uzbðÄX 3JV±Ê‘xïéTh6Þìr·î°TÆ\®¾ˆÊÒ2¢0ì(úøÖôPó‡Š8QñÛëW–b¦ìž]bAßéæEﶊŽ_%fd–Í5?½@\X(´×Ngýiù2˜Äã U !»W(‰±íxž.P²Nyað9T,I©f<[Ÿ¹æEíôÅ82#ÚÙ1x„FÝ}u,Å KjÙÅ& ê½ÕÇÑWíG­!½¼g…}ý¯¯üã÷æì_µÙÇŒ‘ªüþ¯÷×ÇQ_NwÖ• ;íLAˆ·_¿Úý˜ x²¾d\´þ®’ìq.E`±.Ôì˜ey­÷£Êgk¶§UÕ£}ËiÆÇC’Þ¿}ä\r”:V×ôÛc1Ÿ¬ àõ¡n¿Aw¢E£Ðz·]ëk; ÐÏ®Dj6Co¼I¢èý|ÏŒ*WdEtv[ø5mtøÛ{ºOÒQëû¿>ÚìÍæâª%Të¡èn—¢ØÜ“/Ôš½³3mCÑ׿|½¦Ÿ×_n¿½†ÏÑúG?Çë¯$òdÂöâg …€Võ—ÿûûo¤¯ *ñÞߣÐzƒØ*Ãâ›!(jgg£ªçøúú…&f쮤¤åítª/B­ªï½ëQã¡ö­Û–>TÇF¼P]L¬d?î‰ì’Žz¤®Šq¶<ùË?ÿ÷¯W–gÔ›»Ï–½ÃéfAŒ¬õ=aÅÅ™ËB^¡¶¹ÆªòI3YuUr'@ª(’7w&>-eÆoÅ)»ªôöëÛû·wéˆÂpËNu ×ü•s} ì—y†­0%RYÇ阴sh»ç¥l'Å“ã±gÛvûö±ûLêsPÐTÏ>½8Ÿk‘:|dxljJ5.mö£TV%ì•]©µ,ß Dr÷áA®$Ϥ mf×ãÖüN_³yë}÷Ýì?_Xü% íyˆä­¹Ú³9Þu14PÑKbü=l¦p¬ù8íˆK”¬‡BG\ï÷5cÅþVÊ€ Uëì62£>£û¼¸ÌR=r%Ç¥Øe ½ºuRúã”x¹¿™\¨lŸ-Ž”“Àˆåûu~ÝÆì÷5©{&›Ø«ÊxÏáÍ°nû컂Ó߆qÛ ílöxÑ|V°½ˆœîR§O¯˜äì—Õ<¢ì˜¢D¤þ^H-5$ÊRZ“O%»L [,ñÊ" hdö?kS^*]*­"€ãqxIÞߌM;ûHe~GcÇ$ý=êßX”5ð¬êežÀ5?\ø¸lÜ‘X+¸ògyÚž²x[?}¼¾!e¬õ8¼U‘ÑžxJ‹×nÀ¢{—’³¼ûÃñöýÎ¥më[¥\Œm\óôuDOÊÅÚ€°ýõõ5EÅöíýx¨>*“þñ»Ï¥d.Td¼ìuw–ò#¦/5Î ®ìßëØ:ÅSæ`2’©¯Ù÷νۓçsÕÙ»yÒsñðÉ{ïõQ3‘~ÿø½÷UWîØÍ}Wf”…žK/a)ÓK­¸P$±’»~|tâǹ¡ÜììlÊLá rÁs¹œs§ãþ¾ø¯æ£Ÿu=—‡Ü}J)0•¡DДM…(@)E‰{öì±ûlp»ßvÇéw˜ÉüÿÔ_œŠxD)E@D¤„òˆ£Ä¦h¢ÄÑ=£Ï|í¸â^¹wøÞâ'‹Ží\p/ÿâqñ.gÀ±LË}Ó4ÍÛÍÆbc-±VÈFvL¿3}áò…C5¢FÒLÆÚ1”ø;¿ó; õD”m)–@‰Y'û¥?üR"ž°ï°¨ÎW¡ ‘D´´[¨õhk­5{«}ôèQ¯æUkÕ|._¾P~ñÛ/6e“Ä œÄ‰lÉ0 eK6[M\E\E÷ºûøo?‚\•áÜ…9±,4]Û{ßÞ.§ßI( ¹*?R€àÂØh4Ñ}£õz½6H‚T~Q¹gggg«µªlK‰ºáßðówç±…¥=¥úõz°øu_Æ% ŒõFé’lI8ôéCƒÙA¦²Â½…µ×^øö Óç¦Åª „€$ˆXRÊ•å!i±*üÀ¯ß¨«\¬LÏNC æÎÏ©ëUJ©Ó/Ý_êJmJQ…†Ëaáž‚e[ÎoòW~ð ÜÚlåwåGvpÎswå„|‰û‹þð=ÈxäÐk³µ÷S{:4õó)¢ñÛiÛºÝÒ˜6¶lphÝÆŽ}þXp3Ð ýþ{ï×7ê#÷ŽèëõàfðÂw_ÿo(cR¶e…$N¼-äK\JÉoðFíF/sÙ’™;3#÷ø‹¾mÛ³ïÌbIœ„<´7Ù]fÊ4 £T,íß¿_éRŠ…âãŸ{üÈCG†v }åk_ êmªû ×Ülʶt2 t/»Ã…a±,̤Y½^uú?ò3}™^«·r©.…¹¹`1€6Üw°ö¿kîuÏ—Ïï/í··Ø/ýð¥gO<û~ WåB°À9'„ðe.QŠe!AŠUQ=¨I¤””P—ÿöãÕ Ýpk.r«b÷½»!]FÒÈ8™‡h=ZõF•R­F U‚Åà÷Ÿüý™ó3gÏžx}âìëg±…ù»òƒL6³psÁ½æ2…aÝ E¬ Jéìì,c¬\.›¦iõZÕU¦3ïºWÌñœ;?÷½—¿7ù³Ir.8|W”¸â/úB±,¸àRJÁE°@:Ñ#`#l|éÉ/ñeÝ ¸àM¾wßÞ©·¦Î½{®‹©l÷ý»‡á™÷fFK£áRxâĉ…ú‚{Õ=ó?ÏIc¾6.†jJ>"ܜLt',ÃÙ=R¹\‘RòE®­×Üy×Ø`¨ŠZ)Z·[¢%&ÿq2ªP”h¦LJ©Ö£‹‘4ÒÛÓZ–¾#­PÅÚlY›-cƒá8ŽµÙ¾gX¬Š#8YÚ Z$¤Ò{?µ×î³q›5++㯎¯Éµ.k‹µwßÞh%"” ¢ÓïŒÜ;2{~¶ì–‡rC(‘©ìüÅó›6nRoU¥”Ó?Ÿ66ØF{«=þÚ8U(¶±8\ônxGéàƒXþ ß0 US¤,Õ÷«Œ1ÑÏ:Yl"ÛÀc QTMe:“RêšNº‰Ùk6‚†¶N«ÿ²~àSFcÔîµ-˲·Ú^ÝËnÏ~õϾzâÔ ï†7˜,î.f³Yb§mäÈ%7 P¢i›£ŒÀÄëŽãÌÎÍ2•QJ~'_ÈS §þæ”Ó瀪PÛ²uªû >Ó¥´êfÒŒDÄ(€\6Ç‘3!"U)PB©NC›ˆhö›~Í÷¥O)EDé>÷Q"çÜ­¸¹²Ÿyú™üÎ<çÜî³Í^3çä¨Jã³ b$"¦3¦3(î.>û_žýæ_}3¿#ñèLWT¥Ã,ß<ñM=©û¡äãµ@Àì59r»ÏÖuÝL™(±ô@‰ tU ”P¯îÙý6œªTOéÝ€®ëºª{ ÞØc'€„ \¸x8roÞ‹Däþ±Ï;ùÜɱÇÆËíÌ1•‘È8ò”ž ü ê‹š—›™\¦“×_½ÀLš(qæÝ™+—¯äwæu]/í.Í–g)¡ UtU?úù£€©JyÈu] £O! SÙاÇüПšžšø鄞ԙΨJ;Ù¥@qìÁ±Ñ_-Š©Þ”B?ðÕE"*Ï•'ÿirbj‚sÞ©-Ê’,—ÍQrÎ=Ï+ì, D'í¸W]ðÄ“OØ}vS4yÀÝy·ôÉ(DQT\îÆúúû2ýJiÊJÕÜÚñÿtÜ[ðRfªø‰bùrùôwNS•rÎ Ÿ(w;…Ö©þØs¯º¹¹üP>â‘[q‹…âñ'ëI½Ó½¦lrÎA~|NüúÇg¦g^ü΋œNÞÉûÜÞäMÞ<ôСÎòÂPÁ¹Óq/»§_>=55åÍ{”Ðwο“éÏt¾ŸHDÞ¼Gª4e³6K{J(° MàïäÃ÷}…*NÚQT% "»ßöjÞcüXF ¡|±ŒK»K¥'KcŒurÓ”M…*ë@º®£ÀHD§_> Ž}îZ,Çm¼ƒº®+Dá.úq{›J¥Æ_ì÷s/»@ ³%œzs*ÓŸQ@‰0¢„2ÅœŽ“v(¡fÒôC›¨3=hŽãP P¢çyLgº¡;ýΩoœB‰ˆXØY°»s¾swærC93ivЪ€?ðQâäôä©oœÒ©þî[çÕ<…*‘ˆ°‰~Ýïtæ<äf¯ÙÁ–‰šxñ¿¿ØÍ©÷¦(¡ ác ´ôk¥Ÿ¼ô“&4A"zu¤Ô”®ëÈÑç¾ÝkG"BÄ>«Ï¯ù|…÷Ù}Le,ÇöìÙƒ+xê¯OQJ~úhç{0u“ª´<[.ì,êRïp_› Á«y§þê”;ï:ŽùÑè£(P¡Jç. ôjÜÔÍÑÏŽ–þ}‰ þÔñ§Æ_?þ»ÇŸû‹ç>Ž)P¸rñJ$"–d~è£@Î9€àù¥T×uÎ9Õ)SP•¢ÄÀ t¦#"U¨“ur¹\ngÎ}œ)Ï GŽ%zu©,€€ɨ³ö¹¿|®‰MÇq(¡Å=Å|!ý†\ð¦hš)“_婾Tqg1‚/|ñ Wæ¯ýôÑ©é©N`nÕURÊTa4ùödé“% ABWfGFUÔ{€jT#š¶^„ (¥FÒ-I’ÏäÏ_8/Ûr­½Þ ¿ûƒïʶäœ[¦ÅncÞ5ÏÙî fe[&â )%´â@ mð†øW‘L&Ç36¦a6–¸ŠØFÙ–Õ«ÕDw‚%Ù±‡-ÔžþÒÓ~àwóŸÈŸþ§A‚”¤{Ó¤‡8‘mIº‰±ÞÈlÏÒ&Bˆ®ô@ZÕTl#HÈ f ¸ª©W«Wé-”m`vŸîKÏ^˜5“f¢;“1f°„LøË>"AÀngÛHœ@år¥ò‹ŠÿKßÚbÕ®Õ¨N÷Ý·/Ñ“PnQ|îË–\xÈù77šþ’¿-µM7ô^xaáæ¡dd÷Èøǃ0€6¨ª q((¡(‘tHÄC(PB¶e×î{vÓ:œÎf³‡ÎåMÄnø`ù¹& D$q"VÅüõùb¾m°m{¾:q@ŽFÒÙ=rèà!}½Þ!—×ß|]¶d½^¯Í×¼ao²5¦QB%HhCݯ‡Ah¤Œp1l,52Û2£ŒNüdbdÏÈ@ß®á–[fß›Uz”áüðB° ¥ÔUIUI@" Ãû$h‚H†a×±Ç íÙ=’îKïåï½ò÷¯Ì×ç³NöÈ¡#ê­ªlI¥[±ûlÛ²ýÀ¯\ªdvd”…j”¯ðt:=œvîv”n Ù’(Ñ»á)qE‚D‰ H¨·ª|•óã|‰“6á˜ĉ@!VE¡P =Ľê¾öÚkQ3:öð±ÉŸMNŸŸ)Œ †‚ è ®Le±îºÒZIt'ÒýiÛ²¡ø½õÆ[ºªÛýöý¥ûËWË S½Óœ}ýO¾žß™ 3s3(ñ»:pÆt¶g÷Þäd`Œuz§&6U‰xô•¯}%âQ~GÞqÏó@Â#?Ò_”ØäÍòÕ2%4¿#?úÀè³ñlé“%éµjÍ}§ß§¾qŠªÔÔM·æ¦ôGn&Í3¢À=»÷<õôSMlrλ?tø3¿õ÷Š;ru²Nâ ¸@‰³ÿ<ëlsÇMá^qÃ¥ÐJYµ›5s£©­×hœBØ­,Ä!ÑHt'"Á‡PÚ[*~¢èÿÒïL·½f/K2‰Ò¿é+T©\« bâN§i756çfÎMOO?ò™G°…'ž?.†G:wÓK÷¦c4f¨YGb2Ö©p{ïß+¥”(»xÄÍM&]GC2•v+Þ5\­U‡³ÃÑÞÜhΟKô$€´‰Ò­h=¥º[H)å+\~(;,Z" B‰’t“zP¯^­òUžÙži,7:Óí®á*:N:þÊW¿]PÚS*Oÿ´âOŸùSâù¿yÞÜl2•Á-Ô’\ðÆ͆{Í5S¦X¥s§c™v%SI'í`õ]£ZLÆ Úzm`û€Õk¹ón‚&²ÙlýfÝ_ô±…vŸ=þêøÈž—áRxþüùéw§#)ÝŠª¨üß8.ãJkE¢ô—üÐ)¥¤›Ø[mÙ–„÷Š«P…¼{K»K 7¾õío xð@ùbùÄ7NdÓÙýî¯ÎW£¥ˆ/ò¹«sŒ”qpÿÁÇïñ•p¥v³fm¶ìí¶à¢kxp˜¬#j\eëU)¶P£¶Ú`÷Ú„p1dŒesÙù«óå)fñ#l,6n,œ8qböÝYïš7ûÞì̹™r¥lšf¢'!…ôêžÒ­.j7jjšN§ÅªÀlp¯ºöÛÙî<÷çÏU.UŒÆ±ß:655õÌןyâ±'>xðìgÏM —BﺷmÛ¶ãO?ùç'÷ݿϽìrέ-–{Í —Âb®¸ÒZérîv̤)ã’© Û¨®W¼!Û2\ Í^óÌ+güº-Gûîß'P°uŒ/s{‹ƒ Ä6Bø*שŽ€²%§ß›¦QEU8爈-”DjTË8'î57¹>É6°ûLÏNÿæ#¿©PåÍ·Þ¤*Ý{ßÞb¡øü7Ÿ?üéÃûØo÷Úš¢RÑ7è<ä UÈ-ÄJYg_?ë^usÙ®be¾â]õê7ê²-í´M>"•÷+ÆmF°Ø[í®ìÝY¦3jq)%!DéQÝ UU­VÆÉø‹~†Å{Š|‰û¡oõZÆíF¸&äóÿíùê•j&“qîr¤¦aš·›ôV:}~E¬ ¢F5ƒ´‡Ê–ÌïÊI#äaùbyvvöÑÏÊCžÙ‘©^®nÚ´ÉÚjUoT-Ýr«®’PPâì;³•+÷’KUÚ©¼“u¤”Æãô·Ow±õÌ¹Ó —B¶KAñÉÐnѤ”Úz-N+=Š¾Q'qrúû§­”¥25sGÆÜdž{û¶Qëֆ ®R5Ö£ ®„BUWÍÛMÎy³Õ4’ÆøÁéïžÆ0ü×0wwλéåwæç¯Í{7<±*ξvVHao¶Ów¥E(ëbIhL“(ù2¯]«|è "†1¼k˜öP @»éÔäTWvGÖ´LÙ–š¦…7ýûöÚ[íf»ÉT&Û2A—.^:óò™mwl+ÞSdBœýdzöfÛ°¢‹ÁŒúÍzjCª|¹ bU6ñ}¾Ìn,€„LÆØhx5ïËøewÞuÒÔ¯×ßxëÆRbPójJ"VÕèc?V©Tæ¯ÎO¾=ÉCüÀÇ6&Õ¤¢*ê-ªª«šªá*RBϽ{®«ô©’ˆ„¹Ùôª">|X‚d”Bˆªªù{ò†nˆ–€6œþÁéá]ÃÎvÇÜlf2îe—/ó`)-™ÞžV©Ú1 :ýç¼ÍÙLV¶e½^Ÿœ™$@wÖnÔæÊs¤›È¸QnUH‰µcbYLž›œþçé•VÔn5³3CãÔÜj .ÖÚk¸Œ^à9Û5¹–Ô“@`î½¹®GŽ<òèo>:|×0Õ©¾NÜ5h¨!D]¯‚h%túÝéÉ·&UM=rèç¼\.Ÿ}íl¢;Q¼§]-h,5„tåœW竪ªz7<)em¡æÜá$h¢r¹’J¥Fî±RVåbåüÜyÚC jøfú3år$DËÑÁŽýÆØÑCG©F­Í_â3Ī NÖIÞšäË\UU¥[‘-Y¾PîJ¨‰ñ×ÆÝën cF¯1”"*Ѩ&ÛR´„JU(ÞS$=$\ ýП}gv87œ²RV¯åÜí ²ŽÐ[(QÓ«×®J)ƒ B~àlwÌ-fòöd"žÐTíÌψ¦h,7bí¶P‰+´‡Â‡Py¿B×Q¢p1üêŸ|U¡ ¶°4bݱ0 ½›^ýFöPDLß‘«‚él­µF)~wºk(7„-°fÊ3FlÙ²EëÖ!ØBl!"v$Îùäô¤¢({ïÛ;WžCij?=+B1|Ï°±ÞÐÖkÞûÕ(Ó!Da÷Ûþ‡GA2þ£ñ”‘ÊïÊ}èèäÌd†Ð&3%Ha” 2É’AŒ>0jè†{Í•qÙ¡p!„¦j8·@Ä#ÞàÊ:ÅØ`³ïÎv©ªš¾#í¾ïŠeqä¡#„XwŒÁ²Fº‰¶^ ÖV«r©R}¿,´›¦¬”ÉÌM8ig Ö(¥ÏzîÀ¾âCÁne(±ö¹cò#9þÚø÷~ð=ü£F¤ÄH€ŒÉ…`.Ü\-išf¹]9#i, ¦nVÿO•i¬Sáh9JÄwT.V  †óÃ؉ŸNÄ;â+8Y§£Qvfb¦2ªR¦2 ´ã©<ñ»O”v—RF*—˹e7hæ.Œÿx¼ãG4Eó©?~ÊLšLe¹lζíÉ·'¥]óˆÛ½va¨€M ^Ý+Ï•g¦g¢0r¯ºA€Óï "÷¹®ë™ÞŒÙkò{ H°{íý¿¾?•LM¾>édÑ_mÊ&"ºU·ËÚb)ŠRêÃÙáôö´Ò­Ž ‚ˆç/7tcáæ!DJY¾T.WÊáb8|ï°}‡k.†º¦3}ëlçÞ9W(P¢µÙ’-Ét–4’VÊ:wþÜÔôT:†a-±Æz˜B¶%´ÁHc½aÛvu¾ª¬S‚ xõ½úÆOß(ÿ¢ÜˆÅ]EBˆ{Ý%”w3™zPW{ÔÊÅÊÄëĶlß÷Q`DZéDßQx"úËSLgQÙ¶MÌ åÛ ÁÌìŒmÛºª+Tá+<‘ %¾ô×Æ€ÒžÒÄ›}VßSÿù)ì³úJ»Kží¹׫{«`&ÍŽ£ã‡¾·ð±¶éÕ= `÷ÙvÚf*ËíÌ€_÷ w¦|èäÏ&Ç_±)›vÚnb%^¸|!¿#LÝ|õ¥W½º7þÃq?ð#ÿp¼P(èRo6šN¿ãÍ{*&g'KC%ªQ*("–çÊN¿ã8Žëº…³Ït«.U©=d3yu%ÿÇ;¸iZ¦ïû¦0yă0PT…=ùÜI¯æ¥’©€ŸLülÂs=·æ Á¯üJ()î,òøKß©#»UWgú«¯½ê8ŽÝk3Ù½6Hð¾i˜'¿vÒL™OýéS áÅＨë:0U3â ¢0²ûlªÒ 躎ˆ<à(‘QF)@`ìÓcf¯É9Ÿœšœ|{Òó<ò#ÝÐA‚ù€T2…ˆW.^yöÇÏzUe@íüC5Ê€5±IN¿|úä_Ÿ<úÙ£Le“³“èc¿ý9J©dÊîµÍ^ì~D{øØ©¿<åÜéPíc/•-WÊT¥ùùÂîÂÔ›SWæ¯<óGÏPB›ÐDŽ3µ™”™ºrõÊÄ'‚Fà×üŽJÞñ[Í^Ó$f°D<âœCª¸ó._ረè #¬cé¢DF$€ š~óÿ <*ÈXhIEND®B`‚cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/.xvpics/000077500000000000000000000000001133377100500245235ustar00rootroot00000000000000cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/.xvpics/aservelogo.gif000066400000000000000000000053501133377100500273630ustar00rootroot00000000000000P7 332 #IMGINFO:261x111 Indexed (8289 bytes) #END_OF_COMMENTS 80 34 255 ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÛÿÿÿÿÿÿÿÿÿÿÿÿÿþùüØøüøßÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÛÿÿÿÿÿÿÿÿÿÿÿÿþøÜøøøüØÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþûÿÿÿÿÿÿÿßÿÿÿÿÿÿÿÿþÿúÞÿþÿúÿÞþûþÿþþÛþÿþûþÞÿþûþÿÞþûþÿþÛþþÿùüÙþþøøÜùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿÿÿÿÿßÿÿÿÿÿüùùÜùüùùüùÜùùüùÜùøüùüØùüùøÜùüøúüÙýùüùýÙøüÿÿÿÿøØþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿÿÿÿÿÿÿÿÿßÿÿÿÿ—Ûÿÿÿþ“ÿÿ—ÿÿþÿÿÿÿÿûÿÿÿßÿÿÿÿÿÿÿÿÿÿÿÿÿÿþøØÿÿÿÿÿøüÿÿÿÿÿÿÿßÿÿÿÿûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÛNÿÿÿÿ ÿÛ+ÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿØøþÿÿÿÿÿøÞÿÿÿÿÿÿÿÿÿûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿss*ûÿÿÿ ÿÛ+ÿÿÿþÛÿÿÿÿÿßÿûÿÿÿÿßÿÿÿÛÿÿÿÿúüøßþÿÿÿúüÿÿÿÿÿÿÿÿûÿÿÿÿßÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ûrsÿÿÿ ÿÛ+ÿÚ+.+“ÿÿº'.KN»ÿ+NÚ»N+–ÿÿüøùÿÿÿÿßýùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿßÿûÿÿÿÿÿÿÿ»'ÿÚ+ÿÿÿ ÿÛ+ÿ*»ÿû.·ÿ+ºÿ×»ÿ ’ÿÿºÿÛþûÜøüûÿÿÿÿÿÿÿÿÿÿÿßÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿÿÿÿÿON»·ÛÿÿÿÞ'ÿ»—·nOßÿÿÿO¶ÿ ÿÿ¶+ÿÿÿN—ýøøüûßÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûßÿÿÿÿNONONÿÿÿÞ'ßwors“ÞÿÿÿN»ÿþÿ·/ÿÿÿnsüøØüøýúÿÿÿÿÿßÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿÿÿÿÿÿÿ—KþÿÿÿÞÿÿÛ*ÿÿÿÿ»·ÿ ûÿßÚÿÿÿÚ+ÿÿÿ*»øüØøøüØøÿÿÿÿÿÿÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿßÿÿÿûÿÿÿÿÿ/·ÿþÿÿO“þ ÿÛ*ÿs*»³ »ÿ“*—OÛÿÿÿÿON·s*ÿüøøÜøøüØøÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿßÿÿÿÿÿûÿÿ“ßÿÿÿÿÛ’ÿ—ÿûwÿÿ¶OsÚÿÿÿ·w×N»ÿ“ÿÿÿÿrs“þßøøüøØüøøÜÿûsN“ÿÿÛ—r“—»ÿÿÿnÿÿ“Roÿÿ»ÛÛÿÞÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÛ ÚÿÿÿÿÿÿÿÿÿÿÿýøØüøøÜøøÿ ’Ûs*ÿÛs—·*ÿÿ»&ÿOn»—*ÿ·Ûs–Ûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ—&/*·ÿÿÿÿÿÿÿÿÿÿÿÿÿÚýøüøØüù—Oÿþÿ+»Ö ÿÿÿÿÿO–Û+ÿÿßn“ßÛ’—ÛÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÛÿÿÿÿÿÿßÿÿÿÿÿÿÿûÿÿþþøØüús J/J+—ºKÿÿÿsrÿÿ¶.K.+nÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÛÿÿÿÿýÿÿÿÿÿÿÿøØüû—Jÿßûßÿ·.ÿÿÿÛ·/ÿÛ ÿûßÛÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÛÿÿÿþøþÿÿÿÿÿÿØüùÿÛÞÿÛ+º×/ÿÿÿÿ*+ºÿû ¶ÿßK–ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿÿÿþßÿÿûýøÿÿÿÿÿÿþØüûÿÿ¶ *+—ÿÚOÿÿÿÿ“*ÿÿÿÛ K “ÿÿÿÿÿÿßÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûú×õ÷úÛþÿÿûüùÿÿÿÿÿÿØüùÿÿÿÿûÚ×ÿþÿûûúûÿßÿÿÿþÿÿÛÿÿÿÿÿÿÿûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûúÖñÕöÕòúÿÿþØúÿÿÿÿÿõÔøøþøÙùùÑõÕùøùÑõÕùùýÙùüúüÙýùÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÑúÿÿþÿÕö÷úÙôøÛþ÷úöÔöÐúúõúÕñÚþñÕöôÖÿñÕúùúùÞúþþúþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿöÒþúÌÒþûÐòñÑðÔðÖñÑíÞúõÎõÒõÒñûÞìÒñÒúþÍòõÒõ×úÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿöÑÿöÈÑÿùÍúûÞúðÑúÚúúÞÿõÒþúÿÕìßÿúÿõÍþûÌÖúþúÖöÿÿÿÿÿÿÿÿÿÿÿûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÖõÿúÖþÿÐûþÕöÿõÕÿþÖðÿÚíÙûÐÿùÍÿÿôûßðÿÚñÿÙõûÚõÿÿÿÿûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÑúÿúÞûðÒþúÈÍÿúÙÿíÍñÿÕíÚúþÿÕöÿÐÉúÿõßõúÿÞúÿõÖÿÿÿÿûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÑúÿÌòÑòÐÿúÈöÿÔûþÍîÙÿñÕÿõÚÿðÛÿðÍÿùÖÿô×þõÑÕõ÷ÿÿûÿßÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÑþûÌûûöÕûþúßõÑÿúíÖúÿÕúÿúÞûðÿßúþûÐúÿÌöÿÚúúÕûÿÿÿÿÿÿÿÿÿÿÿûÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÕúÖöûÿþòÕûÙöñÑúÖööÕûÕñÚúõÚñÖùÖúÑñÚöñÒõÚúÕ÷úÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûúÖûúÿÿÿûÖöñ×úööÛúÿööÒööÑ÷õÒööÒõ÷úÖöûú×ñöÛúÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿûÿÿÿÞÿÿûÿûþÿûÿÿÿÿûþûÿÿÛúÿÿûÿúÿûÿÿûþÿÿûßûÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÛÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿûßÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÛÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÛÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿcl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/aservelogo.gif000066400000000000000000000201411133377100500257640ustar00rootroot00000000000000GIF89aoç.Ì2Îæbã6+†žâò¯4ê®PîÃjñÓƒî -óâ¦õç©åeøîÃì‘î¢ê‚òèäúö؆šÞö±°ñ¤ˆò´éÎöÁ9òöòòÁþúèê†öÏ=òÇö°ªívqéˆBê KŠ–×òÎꯠî†nùÖ>þúîôâªåX.öÒçvBúÎ’êf^úÚ>êDþþòþö®öÖî¾Rïžxôã î’rþööîÕÓòñíêŽPî®wòâ®öÂÂöÚèdGþúúî•|òÞ‘îÎËí²[úÞBê¦Mõ¶³öÞîÎrêòªãB.êvYærêšê’UúâBþþöðÔŠëˆdܵmë©XúÊÊôæ³ð’‹ê Wþþúòž—úòÒê†è]OúÚÚâÂ~òÚŠöâæx$ùââæj1ò¦’í’gêšEé–2í²fõ¾¼ê|XúæBì®^îÇtþîîúÓ–âRépPöî¼î‰}ç!úúàâ·oì‘'åd/îžúöÎð§0þòòî¾[ê‰NúòÎí¾lëŽYô¹8îzqþææòª–ê|gê˜Pð–Œþò«úêFî¦aêj_î£rò®™ê–Dþêêæ\BúÇ‹é}JîžcúòÂì¶gúÞÞéÉ€îºWèpá®kéˆ(æd=æp4þþîë =ísþþþð«öÆÆöæöº¸ì¸râH,æx4ò¢›æ€5îšúÒÒå^0öÊ:è8ï¥êš쾂úÖÖòª›íºhíÕ‘ê‚ZæjîÎzìŽgòÞší˜fëˆë˜[æªié‚GúöÞêÚší‚gòµ}îštê’ò¦–úòÈò™—úÎÎí®fîÉ{éjQêpZî‚öêµîÚ—æ‰6úî¬îš}ä=0æoAî΂êvjòÚ”þä þúâðªuìš,ò¦¤î©?êˆWî®mí¶[òÚ†úöÒäO-êÂuîŒpòºò®¦î®Fóª¦æn(î–sæj>òÖñšëriêªMêcTò®Žíªbî¢dÿÿÿ!ù ÿ,oþQ H° Áƒ*\È°¡Ã‡!Êx´ª¢Å‹eˆÈ±£Ç CŠI’dŠS¦”Q²¥Ë—0cÊt‰R¥Í‹,gêÜɳ§Oˆ'o µ¸ñ§Ñ£H“Š”1´é#¥P£JZ³éÍ¢S³jÝê2¨U¡O¹ŠK֡׌ÒVŠµ¬Ò pãÊK·®Ý»xóêÝË·¯Ýµ«XrŒjâаn“f˜¨¶±ãÇ#KžL¹²å˘%«lK0ÎÄo)fmù«éÓISÞ¬©JÄ f@M»¶íÛ¸Os>è9glÙŒU NÜòÄãd _ž¼¹rç€}+œúwR.~³÷̽»÷ïàÃþ‹ïŽ ;Aì» ¢ÈÅuƇk¥[?:¾¾}ûóRǘáÚþùÍD@`´•‚_J°1TU„îÀ…68P*Øa…y¦aAU"Ix¡ú©¨ ‹'r´ß{ÍHaŒ0€!ƒú!Aþˆãƒ)™8{ 9S ^‹Ópá‹S*Ù’ݨP‰VƤã”)Т-Hf—þ©$ßB6¢ “Èa•Ó9é!n„¥EUµfž Íù¤@B‰™ Éã¡4J€‘e: WD4:éA•JÚMZJ# (.:†lÚ ¤©…‰`"ºªœþ‹–‰ *ªÆYP­…¸gE&4!¨%9 å‚>j¢/ž‰ ±N6kªÍ:Éà‡v­­²F+­²]U#ÀŽ„¨¡š w@e¡ŽJIí­«ÆÙ¨³R& çªêfËn£îú¸Û®«tzèq†«Ð—4”‰ú,²ùx᜕«¬ ùn¨"œöKñ²PJŒ'È 7»kèŒÕ©Œ»…yîñJ\3AJG|3ÌL;‰P¹´*A§lôQ÷Â<ò©;£ÊsƒèjÌí@ývŒmAs¾ísÌ`}m” O£R¨þÃgBL«» í-Шü0†OŸeÏËU°Ý!…éèäó¾KvÖË¢:j”w.ì@Qó²0B[ïBŸ£‚r–Cî½øÆž8ÓBºïí±$íâ&g¾¶Žΰ@«æºL®jÛ¯Ä@Ã=zÚ¨À©íô&L¨ŠuîìnzX3T}ã_¥Õëñ !|û½ û{,í ïØùûŽê'ïÉöú¬ •\XmɵNþ±,+•”j=™Ñ©{AàÕž7ºsqšêp“œÿ}äKrCÈÂ.ƾ¢„©uLHÕf?Y­­Zœ`n*hÁˆH¯!ké„·…<*]yÓÛ !hÀ—M}þÅ;ÍøZÀb5ÄUpë Û†·4Æ]omìÛ³ 6ň1l#¹Áȉx¿Ó5äé £%(¶²MMQÍc›/M@ Yüò½9‘tR$“8(8*.ªRèëß´V2O}¨ˆãEüg73ùÐ{ï*`æÌè>~-¯Œ\æ$é<ÛM.}&Sd–æ(B‰Œf$¬gy¯Å©?¬tÖ£”ØDô1s¢¬ˆÀˆè26‘yÕ¢än*µ1é=SªzÔ$7ÙÀJ«Xœ "j´”)KÅRŒ<×ä²Y¡jÞ0$ƒôˆ7û#ÍÓPW¬ÂÔ¬j5Ë;®ÏÃ2d— q36—þ:˜ÕxÒ5þ)J“Û¦4i Ý•R{ÝQ[’¹ 54\á,ÈÖzRÎðs_XãcÉ”/‹h¢Ĩíì×( d@9TR ˘R—ôsšK”ÒǨh9AÉt#•’Y ËøƘ`¦÷³ÜzÊ!eþ´¥CzÕ;½Ø“—šÆƒˆs˜Õ6Uƒ„-hdÂ`ÞxF.‡>éQñƒè¶>Ù/¤¾ä,·)JEÈÄZonc#Ô£Oš²±¤¤£U£&`Ve”£÷ê+LSQõmW´Yÿ¹XG«™h4^=uáÕ`ĤדîiØó¤øS}wL‚Η¨8-VBGǦ֫z}þm#Ç9Â~%'Z…Ÿ£ÖJÚyôŸ>Ì­n·XRZ§œjUî6Æ\Åjh´´²œô–;RR·BADLõ¨Çܶ*N!Q\-खЙµ×ý ÑV²Äb w¯—uY«RÇU‰2ì½ðlz¹R<¬,¬p2â˜ð‚—ÚÄšv¼û% cdÀÈÕÁ†¸­cÖˆÀ¨C)™®„ ¦Š!²:éÄ­¥ßLå˜^yß"jùÌ0Oüä”QH¹¼{l\#¸¢C¦ÆM<±Š»®Ž lM¨\#V"z5ÛUµ'¶)gwÌ$íò\œ¢š€€žö—Êå¡N§LÂ*3y'ZôÀzŬ}-Ï—D^`þú¢äÊv9ëË ‚œçLg9Ë#!zÍâ¦'´UBVÐUg¿8š+8Ë8„¢ÍhE#:DÒ¥8m²Ebâ C€t4gDãÀÎå²6‹YV8£"‰žC%*‘3pâÕ°6C"V=‡@|º!\ò±žŒà×#0CjýiMÇÙÓsH¶²mmìŒsÉFC5*áj]Ì XP…¶·íY肳žÃ­âäI«É!‰f5'̆uÏšÙ B TN´Ü«D³M=TÏ¡ÞºÀ‚@yæ0x<(€„6`aaHD­÷ÝãADÎRH‚Æ“0J† :Ôõþ±-oK|Ü‘wÈGŽiÌÜÄæwITÎ i´!æÀ‡ðÀs<˜€x …ðÑ…y° º0C%P¤{üЈÀ ¦þƒ$ «È˲2 ƒ˜!DhC Æ>ö6!œˆ€Ö¾v¯ƒ½ H{É>° B { Y€ ‚ ø=Ð îàÃР aP µfk‰¦‡u^sjuæióV œ0 màð© ððy¡·qIPuU§q?0$ ©VÐ   ?˜ `„NèðVp=½`ç „]zV‡„WGA)ÆEþfÒ@]lÐ ^°1P €ˆ¥ ˆ( zàþ þP°€X€o«Æj'à†KHÛ€hŠ–l.¨‰7x Pà  {²w¨˜ŠªˆŠP ‡| çÐ Ð`ˆY ¦À {²×Š‡|ð¦ w`ˆwp€ ÁwŠ«øF €ð§ ¶_Óª° ¤P …€ z0S€„(ÀQ  ¼Z0mPraº  D ]èíGu°j­¶nïhoa >@™à¸`žà ò™àË -@I-0‘—ðt@tp Ë è` E È °ê°èPäÐ —@ß ‘’00PþC zP šÐ ’° ‘Iá â Û° Êq”H™”G9‡s”|ºÐ]PÅÐ 0Ž( š‚wp€ Ð [Pø`tmà>À ¬° Cˆ~ôèyº Ù–mÚæp7i°| °Y V B àpÒp—¬ÐŒy–hÙó ÊrÀ¨ ½ nà×ÐPwx9`SÉA YPÅ€°Žù˜> m%·nµ6Ž÷AŽ€7vZPÐ ÀSÀ @ êq° J°Â)÷àÊ€Ñ`Ö ° Äþ@ à@˜ @pHÀ €só`æèðOà bp!I½ÐUÀ Ewž8‡]@t°0ñ€sÑ€¾ð›ðЀ; `× ]ðŸÙi¾°À9çx˜p ¤ðŸ·ž°Ð GG÷m• o2o80œ€ó€np A ª£Ð}p¶P™zPÈ ààp @G Á ƒ@ @ KÀ @øƒPP 5Ð 7@ <§¥yð¿ð k@ š0SpŽE0‹À B§Zpi 7§×lz ààq°È€ 6ª¶p@`np þA§Ìp à z0\ Ù°Nà ÌÀ¦7p©‡wÜg˜> J‡¢)JÕ•×€ WÀ¨Sšà±PMÐ ®p°@¦˜¹v°ÖU`™ÐçpGàz¡°ÆÊÛ9…úpþ`¾à¡à |Àe` ê0ì\€šrP ‹§`ÁP þ` ÓÓÐÓài`ˆ.À›1€ ( ½`" [ [P &p ˆ . › ÈÀ÷ú ”`‘ˆ®äÚ꺮ÃÜ`¬ œp¢Ço § ¬ÐÊ0¼°ãpšØ° £àþ 0MpE §SP @ ÕP¡¼Ð ½ c0½Ð êP¡PîùK` ¼Ð ½ G°k`¼` …0šÐ¨P Р€vàèà…à³?› Ù0´l`à°–À¼€ õz¯6Ð ÷ ¶½p… è` û!Рň z€ ¼€ –Öàƒà=Û áC۷ͱm0 f n¡*+º›Zà Åð ЀS€ °¢Ð Ð íîp( ²… *` Çp ÐÀ@“p6Ð òÀŸ ð‚Є@Y 4 Ø Ìþ˵ ‹ =° ;€ Q° À  àà»^€ ØÐ l ¸– îPºÛ¼ ðì0ã YÐ Æ ¸¢ßàŽª pÞp»nÀ¼`½½ë^Àš ÀÃÀ óÀ‚Û¹òfX`Ìà ýÀ¨ÂÉ` *ðª®@ú0£ŽŠº@}›pš€ ¥âˆ¨w@Àåp^ ˆ^€ 6pµxÙ@ØÐœäÈ÷Ký°Q°ÙІˆ ^лŠ ð Å@ ´œöªã Žàx¸ÀÀgÐj Ȱ ´ v°Ðš@“þzÀì€ …ØÐi€Hà©sð±Læo §p l€ ãh£#Ü*@ £°Ð¥ °Ðp”0 Ú° Ù@z Ð@“¦« *ôð "°ÝX³®’ð¼Ð [KŽzн;qp„Pˆì€ Ù€CP‹Û*  £GÐ\; ’‚ܨ‰š{ g°€ r¦Ù@ :J À€ !yˆY ÂPŒ¥p¸0 Bhy¡Š‰ ²Ñ°Ç0·^Éì`ž°¯"P ŸŒ¸Ú°{`ì0»ÈÐC À µ?j¸YÀ Hkt;¬LÐÐù«þ"à zZz`E Θ°=’^ … k “ìªY:–Ì w;Üè• K ±0«˜I g…„|ÑcPúPÀpkŒ™ýp°Ðº°týu³@Z°ƒ Ðà¨Ûª 0É  Ðãà¨(@°Úpá0ÄÛzÀpÚ` ú = S°ª±PE0Ô† €r°[ ±p²µ„ð Qǯ` WÜ6pje` ðA€Øg@ê0Ò ÛcPjpÔp¡ÌAº¶àØ°\P Ÿm ±Âìð‡Ð°ê` yþ  ×ڜ㠛]@Ö,sŸ+ óÀ Ü Ùšrz€ ¿ ÈÂY 7Í!   »\^Ð ´ÜuP‚põj£ÔðÚà[˧РE°ƒð öÐÇ»z€¸¯à ®P QÀ ßÐ Tp*} « ÛW@¯»Îi³Ù ¯ (l [¦Â Ò÷p \°wPÚ@ Pº*‹žp"°ÒCð‚øÑÃÐH0 ‰ª¦&gº¹Áx€ q€Í¸I¦6Lˆ§) ›  ¯ àΉ P-Û MÀµí•z  r` jp¡P ÓÚ`@°›LÆ=½­þ6p¢à íp1yÐ, Ù0C°D~šwL¶0ム0=áÝ jzºá ú4.À` q€°©Úæs­¶CpÄ Û­]äfÀä¦6ª]p ˜ÀYP åÁÊàÊ àëÎÜ  0öÀ£þàSðÙ0PÂhÞ› »†{on6ð£ÉÞ ”`‹ ` ŒœSÕwL ®` §Œ6°wÀÀä»ÊÂéß  ô°¸<ß|MÂ/[—œezœ®Ââ.¶PÐ^³åÛ¼O“§ùÑõЬPÖ²þeò–ËÐ-ßP¾ÔÐ ß rÐ Ó@ ˜°àÇ@þð—|ãg@ŒS`¸Ø k°æóí惰û@°ûà 2š×eÚ Q *p › \,„ðë4©×wÀ ¯@‘í•S r ®Ð Ý@ älÎ÷ "ÂÈŽ™/ àœWù pöhïÊЀ YȈd½ä):ñ³€k½Ä8ŽÃ¬G!°”P ÅUà€ m ý Ep¯ZéQîSPß:íÖÎy¸¼ ù n ;ßÐïœ|Ùàz°Íœ J€ÌIŽ¥Û£PîP•Œ-õ¯Ð0ëô¸lŽ P” Õžª|M =Ú=À ʯüý Ôþ ø\Á‹q»)ÞžœÓ|¯ Õ` ‹  UÀsÌð®v°„Köw° }ðªíð sÛ¥pãÚçÊèÆà{ ˆà;»QŠ‹l¼bÑ A­Š„laKh1PéQpd%¸p‰MNWMhEÖ`ŠÔÔP:°pà^ÚBÈ©8pÁJ±^aÒ¦FŸ:uWŠ«AA§98‚ ‚UêTªU­^ÅšUëV®Uƒ Ä K P€B»SÍ`aîp籋ώ•ñ˜]º0ÞhŒ×.°0Çò÷Äž°À_%`œƒ‡UÁãѲ8¯Åð‚µœ®  àM•ˆ€Ä\ݧÂ6Ã` Ä“ãZOA™Ø ‰ÐÁ¬{å1'"s¸°Spðe¸šØÏbö3Š5èþö×ÏÖŠé)¨·øÊqþW"Æl†TÏAµÛ•OÌè·Vš‹[5—Ý´ç@”úÒèÚŠžíf]€ý Ï¥Þ3©Wýê=w±ÁRµœg9Ï¡Òÿv°{Ýk0ÿëÊ¿žCœI-ëRÃ:ÖnúÊžå\lK_:ˡƶšüÂ…g_û<ÑŽu·¿ÒÅq—Û+ѵžÏ—îp[·ÛÝï÷¸¡rëóÕ:ªè®u·³½ovù%MY&wOQáß»‹QeâÀpr+áÞömÁ§‚aˆóÛâÇxÆ5¾qŽwÜãyÈE>r’—Üä'GyÊU¾r–+8 ;cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/aservepowered.gif000066400000000000000000000015521133377100500264760ustar00rootroot00000000000000GIF89aZ(³àæøÝÎ=aŬŸld,)ƹ š®ëª­?_Œ‚j|n÷äÿÿÿ2Ì!ù,Z(ÿðÉ”œ½8ëÍ»wGƒ…Ç×IèS™–P¶Çë¹çŽB#^áÍf©Ôª£4 £Î@’žJ§2§k¨EŒÑ(j”HŸ`p¨ñ&s_o“z0¢Û"cL7‡;Иc’i]†Åc`rVgPPMMz‹GM!HnxFL=&€š#"$n9‘:TR_x‹5Hz•{€// Œü ‰Bk·{3kJèìYBBÆÉ6*&íZÕœ¹M¦ŒBAÊ@|ÑÀÇZŒï9^*ÁôÁ{šWÛr¦Et8[½sáoö O¾sô¸‹´ƽ-ÛLtœ²_kÅǦÎB›§ö@&Ä갇\ÿr¹EWà“•†WSiõõRqU€€5!¦–Õ'qÝä§ÍrÅmr–MÍ ÞvfcK6Î5sTMs"Cv©µ>vdQ˜í˜’=>2Ó ;ó´H-ˆõ·™6ij+§ä:PæLŒ7¡–åG 0@]P¦G¿-på:ÃI–ž*݃]–ÏÔô?p9 ÓIõóäšRU×å] mµM…*ì \Æ]ð' 7e©’]9 …›IJ1àXƒÚ@Ê–ébENù“Ž|„§_ê”™—Mj3HÉ#«l g7ö¬uÑIiÑ„3^9S,¯_g€µ€÷Û¯…½Š <0ëY´‡Iye;cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/cgitest.sh000066400000000000000000000017221133377100500251310ustar00rootroot00000000000000#! /bin/sh # # return various cgi responses based on the first argument # case $1 in 1) # bogus but common lf headers echo 'Content-Type: text/plain' echo echo "The environment vars are " env echo "==== end ====" ;; 2) # redirect to franz.com, send some headers echo 'Location: http://www.franz.com' echo 'etag: 123hellomac' echo echo -n 'go to franz' ;; 3) # send back unauthorized request echo 'Status: 401 unauthorized request' echo echo 'this request unauthorized' ;; 4) # send back an ok response and something on the error stream echo 'Content-Type: text/plain ' echo ' ' echo "okay" echo stuff-on-error-stream 1>&2 ;; *) # normal crlf headers echo 'Content-Type: text/plain ' echo ' ' echo "The environment vars are " env echo "==== end ====" ;; esac cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/chat.cl000066400000000000000000002673051133377100500244050ustar00rootroot00000000000000;; ;; chat.cl ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of ;; the GNU Lesser General Public License as published by ;; the Free Software Foundation, as clarified by the AllegroServe ;; prequel found in license-allegroserve.txt. ;; ;; This code 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 ;; Lesser General Public License for more details. ;; ;; Version 2.1 of the GNU Lesser General Public License is in the file ;; license-lgpl.txt that was distributed with this file. ;; If it is not present, you can access it from ;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; ;; $Id: chat.cl,v 1.5 2004-02-08 15:41:06 rudi Exp $ ;; Description: ;; aserve chat program ;;- This code in this file obeys the Lisp Coding Standard found in ;;- http://www.franz.com/~jkf/coding_standards.html ;;- (defpackage :user (:use :net.aserve :excl :common-lisp :puri :net.aserve.client :net.html.generator)) (in-package :user) (defvar *chat-home-package* :user) ; :user for now while debugging (defvar *chat-home*) ; home dir for chat info (defvar *chat-home-pics*) ; home dir for chat pics (defvar *chat-picname* 0) (defvar *default-count* 10) (defvar *default-secs* 10) ; secret path to get back to admin control (defvar *quick-return-path* "/xyzz") (defvar *idle-timeout* (* 30 60)) ; 30 minutes (defvar *do-dnscheck* nil) ; translate ip to dns names (defvar *chat-hook* nil) ; invoked when the chat page is accessed (defvar *offer-transcript* nil) ; offer a chat transcript (defparameter *initial-msg-size* 100) ; size of initial message array (defparameter *msg-increment* 200) ; how much to grow array each time ;; parameters ; ; one set of of paraamter is the page style of the top frame ; call (set-style xxx) where xxx is one of the *xxx-style* values ; (set-style *normal-style*) ; (set-style *white-style*) ; ; setting *background-image* to an image url will put that url on ; the background of the top window ; e.g. ; (setq *background-image* "http://www.franz.com/~jkf/aserveback4.gif") ; (setq *background-image* nil) ; set *recent-first* to true to make the newest messages show first ; ; set *show-style* to 1 for normal, 2 for tables ; (setq *show-style* 1) ; (setq *show-style* 2) ; (defparameter *bottom-frames-bgcolor* "#dddddd") ; gray (defparameter *bottom-frames-private* "#ff5555") ; for private messaging (defparameter *private-font-color* "#ff4444") ; red (defparameter *public-font-color* "#ffcc66") ; gold (defstruct color-style bgcolor font-color vlink-color link-color alink-color) (defparameter *normal-style* (make-color-style :bgcolor "#000000" ; black :font-color "#ffcc66" ; gold :vlink-color "#ffaaaa" ; red :link-color "#aaffaa" ; green :alink-color "#aaaaff" ; blue )) (defparameter *white-style* (make-color-style :bgcolor "#ffffff" ; white :font-color "#000000" ; black :vlink-color "#ff0000" ; red :link-color "#0000ff" ; blue :alink-color "#00aa00" ; green )) (defvar *top-frame-bgcolor* ) (defvar *top-frame-font-color*) (defvar *top-frame-vlink-color*) (defvar *top-frame-link-color*) (defvar *top-frame-alink-color*) (defvar *background-image* nil) (defvar *message-id-hook* nil) ; if true it can contribute to the messsage line (defvar *max-active-time* #.(* 2 60)) ; after 2 minutes no longer active (defvar *recent-first* t) ; if true show most recent messages first (defvar *show-style* 1) ; 1 = tables, 2 = just entries ; true if we wish to restrict messaging at all based on logged in ; and level (defvar *restrict-messages* nil) ; true if we show the machine name of chatters to everyone instead ; of just the owner (defvar *show-machine-name-to-all* t) ; force it to be loaded ;(defparameter *ensure-ef* (find-external-format :utf-8)) ;; sample building command to create a standalone chat serve #| (generate-application "allegrochat" "allegrochat/" '(:sock :process :seq2 :acldns "aserve/aserve.fasl" "aserve/examples/chat.fasl" ) :restart-init-function 'start-chat-standalone :include-compiler nil :read-init-files nil :include-debugger t :ignore-command-line-arguments t) |# ; ; query attribute usage: ; u = controller ustring ; c = chat ustring ; s = secret key (specific to the object being accessed) ; x = user uid ; pp = uid of person sending message to, * means all ; purl = picture url ; z = lurk ; y = delete message ; b = upgrade user (defclass master-chat-controller () ((controllers :initform nil ; list of chat-controller instances :initarg :controllers :accessor controllers) (ustrings :initform nil :initarg :ustrings :accessor ustrings) (master-lock :initform (mp:make-process-lock :name "chat master") ;; used when doing serious altering to chat info :reader master-lock) (secret-key :initarg :secret-key ;; to unlock the setup-chat :initform (make-unique-string) :reader secret-key) (users :initform nil :initarg :users ;; list of user objects :accessor users) )) (defvar *master-controller* nil) ; the master-controller instance (defclass chat-controller () ;; describes a whole set of chats ((chats :initform nil ; list of chat instances :initarg :chats :accessor chats) (owner-name :initarg :owner-name :reader owner-name) (controller-name :initarg :controller-name :reader controller-name) (ustring :initarg :ustring :accessor ustring) ; un (ustrings :initform nil ;; ustrings of all the chats :initarg :ustrings :accessor ustrings) (secret-key :initarg :secret-key ;; knowing this key gives you access to ;; changing the parameters of the chat :accessor secret-key) (controller-uri :initarg :controller-uri ;; uri to reach this controller page :accessor controller-uri) (controller-query-string :initarg :controller-query-string ; u=xxxxx&s=xxxxx specify this controller and ; the secret key for this controller :reader controller-query-string) )) (defclass chat () ((name :initarg :name :reader chat-name ) (state :initform :open ; :open or :closed :initarg :state :accessor chat-state) (ustring :initarg :ustring :accessor ustring) (filename :initarg :filename ;; name of file holding chat info. ;; should be just a name, no directory stuff, so ;; it can be relative to the chat home :accessor chat-filename) (secret-key :initarg :secret-key ;; to do admin things to this chat :initform (make-unique-string) :reader secret-key) (chat-query-string :initarg :chat-query-string ;; u=xxxx&c=yyyyyy indentifies chat :reader chat-query-string) (chat-owner-query-string :initarg :chat-owner-query-string ;; u=xxxx&c=yyyyyy&s=xxxx indentifies chat :reader chat-owner-query-string) (messages :initform (make-array *initial-msg-size*) :accessor chat-messages) (message-next :initform 0 ;; index in the messages array of place ;; to store next message :accessor chat-message-next) (message-number :initform 0 :initarg :message-number ;; message number of the next message :accessor chat-message-number) (message-archive :initform 0 :initarg :message-archive ;; 1+ last message number archived so far :accessor chat-message-archive) ; used by experimental code to delete private messages ; message number to scan next (message-prvcheck :initform 0 :accessor chat-message-prvcheck) ; list of deleted message numbers since the last archive (messages-deleted :initform nil :initarg :messages-deleted :accessor chat-messages-deleted) (message-lock :initform (mp:make-process-lock :name "chat-message") ; grab this before changing the above :accessor chat-message-lock) ;; list of people monitoring this chat (viewers :initform (make-viewers) :accessor chat-viewers) ; used as index value in the redirect struct (redirect-counter :initform 0 :initarg :redirect-counter :accessor redirect-counter) ; list of redirect structures (redirects :initform nil :initarg :redirects :accessor chat-redirects) )) (defstruct user handle ; official handle of the user password ; password string ustring ; unique string of this user pstring ; unique string, this one denotes user as a send target cookie ; cookie stored under achat name level ; nil - novice, 1 - higher privs (time 0) ; time of last user activity to-users ; string holding comma sep list of users to send to (nil=all) ) (defstruct viewers (lock (mp:make-process-lock :name "viewers-lock")) list ; list of viewent ) (defstruct viewent time ; time of last read, nil to make this one unused user ; if user access, then user object ipaddr ; if random access then ipaddr hostname ; string if we've figured it out ) (defstruct message number ; is unique for each chat ipaddr ; integer ip address of the source dns ; dns name corresponding to the ip address handle ; from handle (for unlogged in user) real ; true if this is a real handle of a logged in user to ; if non nil then a list of handles who are the target of this message ; if nil then this goes to no-one ; if t then this goes to everyone time ; string - message time in a pretty format (ut 0) ; universal time of message body) (defstruct redirect index ; unique name for each redirect ;; structure describing the redirection of a group of ip addresses ipaddr ; bits not under the mask are ignored maskbits ; bits from 0 to 32 mask ; the actual mask to ; where to send the redirect before ; true if we check before seeing if they are logged in info ; string describing this redirect (use 0) ; use count active ; true if active ) ;; roles ; master-controller - can create controllers. has a secret key (s) ; controller - can create chats, each has a public key (u) and ; a private key (s). ; chat - is a collection of posted messages. has a public key (c) ; and a controller public key (u) and a secret key (s) ; Most access the chat using u and c. If you also know s then ; you have owner priviledges to the chat ; ;; pages ; ; url set what ; ; setup-chat - if no chat setup yet, bring up first page ; with link to first controller page page ; setup-chat s s has master control key, bring up page of ; existing chat controllers and form for ; craeting new one. This is the master controller ; page. ; new-controller s,name,controllername ; posted from setup-chat ; s is the master controller secret key ; name and controllername are used to build ; new controller object. ; controller u,s u has controller public string, s has ; controller private string, show chats by ; this controller and offer to create a new one ; create-chat u,s,name,filename create a new chat under the controller ; denoted by u. s has the controller private ; string (secret key) ; chat u,c,[s] build frameset for the given chat. ; s is the chat secret key [if given.] ; chattop u,c,[s],count,secs,y,z,b display count message and refresh in secs ; chaviewers u,c,[s] list who is watching the chat ; chatenter u,c,[s],pp,purl box into which to enter a message ; chatcontrol u,c,[s] specify message count and refresh seconds ; chatlogin u,c,x,[s] login to a existing user or create a new user ; ; chatloginnew u,c,[s],handle,password,password2 ; define new user ; ; chatlogincurrent u,c,[s],handle,password ; login as an existing user ; ; chatmaster u,c,s control elements of the chat. ; ; ; top level published urls ; functions (defun start-chat (&key port home restart (listeners 10)) ;; start the chat system going (declare (special socket::*dns-configured*)) ;(unpublish :all t) ; useful during debugging, remove afterwards (if* (not (stringp home)) then (error "must specify :home value as a string naming a directory (no trailing slash)")) (setq *chat-home* home) (ignore-errors (excl::mkdir (setq *chat-home-pics* (concatenate 'string *chat-home* "/pics")) #o755)) (setq *chat-picname* (logand #xffffff (* 8 (get-universal-time)))) (publish-directory :prefix "/chatpics" :destination *chat-home-pics* ) (setq *master-controller* nil) (if* (not restart) then (load-existing-chat *chat-home*) (let (did-fixup) ;; temp to add cookies to old chat (dolist (user (users *master-controller*)) (if* (null (user-cookie user)) then (setf (user-cookie user) (make-unique-string)) (setq did-fixup t))) (if* did-fixup then (dump-existing-chat *chat-home*)))) (if* *master-controller* then ; we have an existing chat setup (publish-chat-links) (start-chat-archiver *master-controller*) ) (publish :path "/setup-chat" :function 'setup-chat ; :content-type "text/html; charset=utf-8" :content-type "text/html" ) ; setup for reverse dns lookups. don't do reverse lookups if we ; have to use the C library #+(and allegro (version>= 6 0)) (if* (and (boundp 'socket::*dns-configured*) socket::*dns-configured*) thenret else (socket:configure-dns :auto t) (setq *do-dnscheck* socket::*dns-configured* socket::*dns-mode* :acldns)) (if* port then (net.aserve:start :port port :listeners listeners ; :external-format (crlf-base-ef :utf-8) ) ) ) (defun start-chat-standalone () ;; useful function for starting chat standalone where the ;; port and home arguments are required (if* (not (eql 5 (length (acl-compat.system:command-line-arguments)))) then (format t "use: ~s port home~%" (acl-compat.system:command-line-argument 0)) (exit 1)) (let ((port (read-from-string (nth 3 (acl-compat.system:command-line-arguments)))) (home (nth 4 (sys:command-line-arguments)))) (start-chat :port port :home home) (loop (sleep 9999999)))) (defun shutdown-chat () ;; stop the chat (net.aserve:shutdown) (setq *master-controller* nil) (sleep 10) (exit 0 :quiet t)) (defun publish-chat-links () ; debugging only. builds link to the master controller page (publish :path *quick-return-path* :function 'quick-return-master ; :content-type "text/html; charset=utf-8" :content-type "text/html" ) ; post'ed from form in setup-chat (publish :path "/new-controller" :function 'new-controller ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/controller" :function 'existing-controller ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) ; get'ed from the controller page when user asks to create a chat (publish :path "/create-chat" :function 'create-chat ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chat" :function 'chat ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chattop" :function 'chattop ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chatenter" :function 'chatenter ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chatenter-pic" :function 'chatenter-pic ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chatcontrol" :function 'chatcontrol ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chatlogin" :function 'chatlogin ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chatloginnew" :function 'chatloginnew ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chatlogincurrent" :function 'chat-login-current ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chatviewers" :function 'chatviewers ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chatmaster" :function 'chatmaster ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) (publish :path "/chattranscript" :function 'chattranscript ;:content-type "text/html; charset=utf-8" :content-type "text/html" ) ) (defun load-existing-chat (home) ;; read in and build the chat information (declare (special user::value1)) (let ((master-file (concatenate 'string home "/cmaster.cl"))) (if* (probe-file master-file) then (with-standard-io-syntax (load master-file) (if* (boundp 'user::value1) then (setq *master-controller* user::value1) ; ensure users have cookies ) ;; now read in chat data (dolist (controller (controllers *master-controller*)) (dolist (chat (chats controller)) (and (archive-filename chat) (probe-file (archive-filename chat)) (let (did-delete) (with-open-file (p (archive-filename chat) :direction :input :external-format :octets) (do ((message (read p nil :eof) (read p nil :eof))) ((eq message :eof) ; use everything is archived we've read (setf (chat-message-archive chat) (chat-message-number chat)) ; remove those put back on redundantly ; by delete-chat-message (setf (chat-messages-deleted chat) nil)) (if* message then (if* (and (consp message) (eq :delete (car message))) then (mapcar #'(lambda (num) (delete-chat-message chat num t nil)) (cdr message)) (setq did-delete t) else (add-chat-message chat message))))) (if* did-delete then ; write out archive again this time ; without the deleted messages (format t "Rewriting ~s~%" (archive-filename chat)) (let ((messages (chat-messages chat))) (with-open-file (p (archive-filename chat) :direction :output :if-exists :supersede ;:external-format :utf-8 ) (dotimes (i (chat-message-next chat)) (let ((message (svref messages i))) (if* (message-to message) then (pprint (svref messages i) p))))))))))))))) (defun dump-existing-chat (home) (mp:with-process-lock ((master-lock *master-controller*)) (labels ((dump-master-chat-controller (masterc) `(make-instance 'master-chat-controller :ustrings ',(ustrings masterc) :secret-key ',(secret-key masterc) :controllers (list ,@(mapcar #'dump-chat-controller (controllers masterc))) :users ',(users masterc) )) (dump-chat-controller (controller) `(make-instance 'chat-controller :chats (list ,@(mapcar #'dump-chat (chats controller))) :owner-name ',(owner-name controller) :controller-name ',(controller-name controller) :ustring ',(ustring controller) :ustrings ',(ustrings controller) :secret-key ',(secret-key controller) :controller-uri ',(controller-uri controller) :controller-query-string ',(controller-query-string controller))) (dump-chat (chat) `(make-instance 'chat :name ',(chat-name chat) :state ',(chat-state chat) :ustring ',(ustring chat) :filename ',(chat-filename chat) :secret-key ',(secret-key chat) :chat-query-string ',(chat-query-string chat) :chat-owner-query-string ',(chat-owner-query-string chat) :redirect-counter ',(redirect-counter chat) :redirects ',(chat-redirects chat) )) ) (let ((new-master-file (concatenate 'string home "/ncmaster.cl")) (master-file (concatenate 'string home "/cmaster.cl")) (value)) (setq value `(setq user::value1 ,(dump-master-chat-controller *master-controller*))) (with-open-file (p new-master-file :direction :output :if-exists :supersede ;:external-format :utf-8 ) (with-standard-io-syntax (let ((*package* (find-package *chat-home-package*))) (format p ";;Automatically generated, do not edit~%") (print `(in-package ,*chat-home-package*) p) (pprint value p) (terpri p)))) ; success, so make it the official one (ignore-errors (delete-file master-file)) #-(and allegro (version>= 6 2 :pre-beta 11)) (rename-file new-master-file master-file) #+(and allegro (version>= 6 2 :pre-beta 11)) (rename-file-raw new-master-file master-file) )))) (defun quick-return-master (req ent) ;; quick hack to get us to the master controller while debugging (if* (null *master-controller*) then (ancient-link-error req ent) else (with-http-response (req ent) (with-http-body (req ent) (html (:html (:body "The master controllers is " ((:a href (format nil "setup-chat?s=~a" (secret-key *master-controller*))) "here")))))))) (defun illegal-access (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head (:title "illegal access")) (:body "You are attempting to gain illegal access to this " "chat control. Stop doing this.")))))) (defun setup-chat (req ent) ;; this is the first function called to start a whole chat ;; system going (building a master controller) and is also ;; the function used by the master controller to specify new ;; controllers. (if* (null *master-controller*) then (setq *master-controller* (make-instance 'master-chat-controller)) (dump-existing-chat *chat-home*) (do-first-setup-page req ent) (start-chat-archiver *master-controller*) elseif (not (equal (secret-key *master-controller*) (request-query-value "s" req))) then (illegal-access req ent) else (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Chat Setup")) (:body (:h1 "Chat Setup") (if* (controllers *master-controller*) then (html (:h2 "Existing Chat Controllers") (display-chat-controllers (controllers *master-controller*)))) (:h2 "New Chat Controller") " This page is used to create a chat controller which " "then can be use to create chats." " Just fill out the form below and click on submit " " and you'll be taken to a new controller page. " ((:form :action "new-controller" :method "POST") ((:input :type "hidden" :name "s" :value (secret-key *master-controller*))) ((:input :type "text" :name "name" :size 30 :maxlength 30)) "Your Name" :br ((:input :type "text" :name "controllername" :size 30 :maxlength 30)) "Name for this collection of chats" :br ((:input :type "submit"))))))))) (defun display-chat-controllers (controllers) ;; display a table of chat controllers (html ((:table :border "1" :cellspacing 1 :cellpadding 3) ((:tr :bgcolor "#9999ff") (:th "Owner Name") (:th "Collection Name") (:th "Link")) (dolist (controller controllers) (html (:tr (:td (:princ-safe (owner-name controller))) (:td (:princ-safe (controller-name controller))) (:td ((:a :href (format nil "controller?~a" (controller-query-string controller))) "Go To Page")))))))) (defun do-first-setup-page (req ent) ;; called when setup-chat is done for the first time ;; gives the special url that can be used by the chat superadmin ;; to give chat controllers to others (publish-chat-links) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head (:title "First Setup")) (:body (:h1 "First Setup") "This is the first access to this chat setup and you " "are now the chat super-adminstrator." " This " ((:a href (format nil "setup-chat?s=~a" (secret-key *master-controller*))) "link") " will take you to a page where you can create chat" "controller who then can create chats" " Once you follow the link to the page be sure to bookmark " " the page since this will be the only way to " " exert your superadminstrator powers."))))) ) (defun new-controller (req ent) (if* (or (not (eq (request-method req) :post)) (not (equal (secret-key *master-controller*) (request-query-value "s" req)))) then ; someone's playing around (return-from new-controller (ancient-link-error req ent))) (with-http-response (req ent) (let ((query (request-query req))) (let ((controller (new-chat-controller :owner-name (cdr (assoc "name" query :test #'equalp)) :controller-name (cdr (assoc "controllername" query :test #'equalp)) :secret-key (make-unique-string)))) (mp:with-process-lock ((master-lock *master-controller*)) (push controller (controllers *master-controller*))) (dump-existing-chat *chat-home*) (with-http-body (req ent) (html (:html (:head (:title "Created New Controller")) (:body "A new controller page has been created, go to " ((:a :href (format nil "controller?~a" (controller-query-string controller))) "here") " to see the page")))))))) (defun existing-controller (req ent) ;; when an owner visits his control page (let ((controller (controller-from-req req))) (if* (or (null controller) (not (equal (secret-key controller) (cdr (assoc "s" (request-query req) :test #'equalp))))) then (ancient-link-error req ent) else (with-http-response (req ent) (with-http-body (req ent) (display-controller-page controller)))))) (defun display-controller-page (controller) ;; display the html for the controller page (html (:html (:head (:title "Controller for " (:princ-safe (controller-name controller)))) (:body (:h1 "Controller for " (:princ-safe (controller-name controller))) (:h2 "Owner is " (:princ-safe (owner-name controller))) (if* (null (chats controller)) then (html (:h2 "There are no chats defined yet")) else (display-chat-list (chats controller) t)) ((:form :action (concatenate 'string "create-chat?" (controller-query-string controller)) :method "POST") :hr (:h2 "Create New Chat") ((:input :type "text" :name "name" :size 30) " Enter Name for Chat") :br ((:input :type "text" :name "filename" :value (format nil "chat-~a.txt" (make-unique-string)) :size 30)) " File where messages are stored" :br ((:input :type "submit" :value "Create Chat"))))))) (defun display-chat-list (chats owner-p) ;; display the characteristics of the chats in a table (html ((:table :border "1" :cellspacing 1 :cellpadding 3) ((:tr :bgcolor "#9999ff") (:th "Chat name") (:th "State") (:th "Link") (if* owner-p then (html (:th "Owner Link"))) ) (dolist (chat chats) (html (:tr (:td (:princ-safe (chat-name chat))) (:td (:princ-safe (chat-state chat))) (:td ((:a :href (concatenate 'string "chat?" (chat-query-string chat))) "Go to Chat")) (if* owner-p then (html (:td ((:a :href (concatenate 'string "chat?" (chat-owner-query-string chat))) "Go to Chat as owner")))))))))) (defun new-chat-controller (&key owner-name controller-name secret-key) ;; create a new chat controller object (let (ustring) ; create a unique string to indentify this controller (loop (setq ustring (make-unique-string)) (mp:without-scheduling (if* (not (member ustring (ustrings *master-controller*) :test #'equal)) then (push ustring (ustrings *master-controller*)) (return)))) (let ((controller (make-instance 'chat-controller :owner-name owner-name :controller-name controller-name :secret-key secret-key :ustring ustring :controller-uri (compute-controller-uri ustring) :controller-query-string (format nil "u=~a&s=~a" ustring secret-key)))) controller))) (defun compute-controller-uri (ustring) (format nil "controller?u=~a" ustring)) (defun make-unique-string () ;; make a unique string that's not one of the other strings ;; want it to around five characters long (let ((time (get-universal-time))) ; randomize things (dotimes (i (logand time #xf)) (random 10)) (dotimes (i (logand time #x1f)) (random 10)) (setq time (logxor time (random 4342211881376))) (setq time (logxor time (random (load-time-value (get-universal-time))))) ; make sure it's at least 8 digits base 26 (if* (< time #.(expt 26 8)) then (incf time #.(expt 26 8))) ; (string-downcase (format nil "~26r" time)))) (defun create-chat (req ent) ;; create a new chat for the given controller (let ((controller (controller-from-req req))) (if* (or (null controller) (not (equal (secret-key controller) (request-query-value "s" req)))) then (ancient-link-error req ent) else (let (ustring) (loop (setq ustring (make-unique-string)) (mp:without-scheduling (if* (not (member ustring (ustrings controller) :test #'equal)) then (push ustring (ustrings controller)) (return)))) (let ((chat (make-new-chat controller :name (request-query-value "name" req) :filename (request-query-value "filename" req) :ustring ustring))) (mp:without-scheduling (push chat (chats controller))) (dump-existing-chat *chat-home*) (with-http-response (req ent) (with-http-body (req ent) (display-controller-page controller)))))))) (defun ancient-link-error (req ent) (with-http-response (req ent) (with-http-body (req ent) (html "This link is ancient and won't work any more")))) (defun controller-from-req (req) ;; locate controller named by request (let ((ustring (request-query-value "u" req))) (if* ustring then (dolist (controller (controllers *master-controller*)) (if* (equal ustring (ustring controller)) then (return controller)))))) (defun chat-from-req (req) ;; find the chat object given the req (let ((controller (controller-from-req req))) (if* controller then (let ((chat-ustring (cdr (assoc "c" (request-query req) :test #'equalp)))) (if* chat-ustring then (dolist (chat (chats controller)) (if* (equal chat-ustring (ustring chat)) then (return chat)))))))) (defun user-from-req (req) ;; find the user object from this request (let ((val (request-query-value "x" req))) (if* val then (let ((user (user-from-ustring val))) (if* (and user (equal (user-cookie user) (get-chat-cookie req))) then user))))) (defun user-from-ustring (ustring) ;; find user object based on unique string (find ustring (users *master-controller*) :key #'user-ustring :test #'equal)) (defun user-from-pstring (ustring) ;; find user object based on unique string (find ustring (users *master-controller*) :key #'user-pstring :test #'equal)) (defun users-from-ustring (ustring) ;; ustring may be a comma separated value (let (res) (dolist (usr (net.aserve::split-on-character ustring #\,)) (let ((u (user-from-ustring usr))) (if* u then (pushnew u res :test #'eq)))) (nreverse res))) (defun users-from-pstring (ustring) ;; ustring may be a comma separated value (let (res) (dolist (usr (net.aserve::split-on-character ustring #\,)) (let ((u (user-from-pstring usr))) (if* u then (pushnew u res :test #'eq)))) (nreverse res))) (defun user-from-handle (handle) ;; locate the user object given the handle (find handle (users *master-controller*) :key #'user-handle :test #'equal)) (defun make-new-chat (controller &key name filename ustring) ;; make a new chat object (let ((secret-key (make-unique-string))) (make-instance 'chat :name name :ustring ustring :filename filename :secret-key secret-key :chat-query-string (format nil "u=~a&c=~a" (ustring controller) ustring) :chat-owner-query-string (format nil "u=~a&c=~a&s=~a" (ustring controller) ustring secret-key) :secret-key secret-key))) (defun get-chat-cookie (req) (cdr (assoc "aschat" (get-cookie-values req) :test #'equal))) (defun set-chat-cookie (req cookie) (set-cookie-header req :name "aschat" :value cookie :expires :never)) ; chat frames: ; ; chattop ; chatviewers chatenter chatcontrol (defun chat (req ent) ;; generate the chat frames (format t "start chat~%") (force-output) (let ((chat (chat-from-req req)) (user (user-from-req req)) (qstring)) (if* user then (setf (user-time user) (get-universal-time))) ; do redirect check (if* (null user) then ; do not logged in check (if* (redir-check req ent chat t) then (return-from chat))) ; now the logged in or not logged in check (if* (redir-check req ent chat nil) then (return-from chat)) (if* *chat-hook* then (if* (funcall *chat-hook* req ent) then (return-from chat))) (if* (null chat) then (ancient-link-error req ent) else (setq qstring (add-lurk req (add-secret req (add-user req (chat-query-string chat))))) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head (:title "chat - " (:princ-safe (chat-name chat))) ) ((:frameset :rows "*,160") ((:frame :src (format nil "chattop?~a&count=~d&secs=~d&hitbut=did" qstring *default-count* *default-secs*) :name "chattop") ((:frameset :cols (if* user then "15%,*,20%" else "*,20%")) (if* user then (html ((:frame :src (concatenate 'string "chatviewers?" qstring))))) ((:frame :src (concatenate 'string "chatenter?" qstring) :name "chatenter")) ((:frame :src (concatenate 'string "chatcontrol?" qstring)))) (:noframes "This chat program requires a browser that supports frames" )))))))))) (defun add-user (req current-string) ;; if a user has been specified in the chat ;; the add it's x string to the current string (let ((val (request-query-value "x" req))) (if* val then (format nil "~a&x=~a" current-string val) else current-string))) (defun add-secret (req current-string) ;; if a secret string has been defined then add it onto the ;; current string (let ((val (request-query-value "s" req))) (if* val then (format nil "~a&s=~a" current-string val) else current-string))) (defun add-reverse (req current-string) ;; if a reverse value has been defined then add it onto the ;; current string (let ((val (request-query-value "rv" req))) (if* val then (format nil "~a&rv=~a" current-string val) else current-string))) (defun add-lurk (req current-string) ;; if a lurk has been defined then add it onto the ;; current string (let ((val (request-query-value "z" req))) (if* val then (format nil "~a&z=~a" current-string val) else current-string))) (defun chattop (req ent) ;; put out the top part of the chat (let* ((chat (chat-from-req req)) (user (user-from-req req)) (is-owner (equal (and chat (secret-key chat)) (request-query-value "s" req))) (qstring)) (if* (null chat) then (return-from chattop (ancient-link-error req ent))) ; do redirect check (if* (null user) then ; do not logged in check (if* (redir-check req ent chat t) then (return-from chattop))) ; now the logged in or not logged in check (if* (redir-check req ent chat nil) then (return-from chattop)) (let ((delete (request-query-value "y" req))) (if* delete then (delete-chat-message chat (compute-integer-value delete) is-owner (and user (user-handle user)) ))) (let ((upgrade (request-query-value "b" req))) (if* upgrade then (let ((user (user-from-ustring upgrade))) (if* user then (setf (user-level user) 1) (dump-existing-chat *chat-home*))))) (let* ((count (or (compute-integer-value (request-query-value "count" req)) 10)) (secs (or (compute-integer-value (request-query-value "secs" req)) 0))) (if* (not (equal "385" (request-query-value "z" req))) then (track-viewer chat user req)) (if* user then (if* (zerop (user-time user)) then (setf (user-time user) (get-universal-time))) (if* (equal (request-query-value "hitbut" req) "did") then ; user hit button in the chatcontrol frame (setf (user-time user) (get-universal-time)) else ; test to see if time has expired (if* (> (- (get-universal-time) (user-time user)) *idle-timeout*) then (do-idle-timedout req ent (format nil "chat?~a" (add-lurk req (add-secret req (add-user req (chat-query-string chat)))))) (return-from chattop)))) (with-http-response (req ent :timeout 500) (setq qstring (format nil "~a&count=~d&secs=~d" (add-lurk req (add-reverse req (add-secret req (add-user req (chat-query-string chat))))) count secs)) (with-http-body (req ent) (html (:html (:head (:title "chat frame") (if* (and secs (> secs 0)) then ; setup for auto refresh (html ((:meta :http-equiv "Refresh" :content (format nil "~d;url=chattop?~a" secs qstring))))) ((:body :if* *background-image* :background *background-image* :if* (not *background-image*) :bgcolor *top-frame-bgcolor* :text *top-frame-font-color* :link *top-frame-link-color* :vlink *top-frame-vlink-color* :alink *top-frame-alink-color* ) (if* (or (null secs) (zerop secs)) then ; indicate frozen (html (:center (:b ((:font :color "green") "--*-- Frozen --*--"))) :br)) (show-chat-info chat count (not (equal "1" (request-query-value "rv" req))) (if* user then (user-handle user)) (if* is-owner then qstring) (format nil "~a&count=~d&secs=~d" (add-lurk req (add-reverse req (add-user req (chat-query-string chat)))) count secs))))))))))) (defun chatenter (req ent) ;; ;; this is the window where you enter the post and your handle. ;; (let* ((chat (chat-from-req req)) (user (user-from-req req)) (pp (or (request-query-value "pp" req) "*")) ; who to send to (ppp (request-query-value "ppp" req)) ; add a user to the dest (purl (request-query-value "purl" req)) (kind :multiline) (to-users (users-from-pstring pp)) (qstring)) (if* (null chat) then (return-from chatenter (ancient-link-error req ent))) (let* ((body (request-query-value "body" req)) (handle (request-query-value "handle" req))) (setq qstring (add-secret req (add-user req (chat-query-string chat)))) (if* user then (setf (user-time user) (get-universal-time)) (if* ppp then ; add this user (setq pp (setf (user-to-users user) (concatenate 'string (or (user-to-users user) "") "," ppp))) (setq to-users (users-from-pstring pp)) elseif (equal pp "*") then (setf (user-to-users user) nil) else (setf (user-to-users user) pp))) ; do redirect check (if* (null user) then ; do not logged in check (if* (redir-check req ent chat t) then (return-from chatenter))) ; now the logged in or not logged in check (if* (redir-check req ent chat nil) then (return-from chatenter)) (if* (and body (not (equal "" body))) then ; user added content to the chat (add-chat-data chat req handle body user to-users purl nil)) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head :newline " " :newline ) ((:body :onload "sf()" :bgcolor (if* to-users then *bottom-frames-private* else *bottom-frames-bgcolor*)) ((:form :action (concatenate 'string "chatenter?" qstring) :method "POST" :name "f" ) (:center (if* (eq kind :multiline) then (html (:table (:tr (:td (:center ((:input :name "send" :value "Send" :type "submit")) " " (if* user then (html (if* to-users then (html "Private msg from: ") else (html "From: ")) (:b (:princ-safe (user-handle user))) " to " (:b (if* to-users then (dolist (to-user to-users) (html (:princ-safe (user-handle to-user)) " " )) else (html "all")))) else (html "Your Name" ((:input :name "handle" :type "text" :tabindex 3 :size 20 :value (if* handle then handle else ""))))) " -- " ((:a :href (format nil "chatlogin?~a" qstring) :target "_top") "Login") " --    " ((:input :name "send" :tabindex 2 :value "Send" :type "submit")) (if* user then (html " " ((:a :href (format nil "chatenter-pic?~a&pp=~a" qstring pp)) "upload picture"))) ))) (:tr (:td ((:textarea :name "body" :tabindex 1 :cols 50 :rows 5)) ((:input :type "hidden" :name "pp" :value pp)))) (:tr (:td (:center ((:input :type "text" :size 40 :maxlength 100 :value (or purl "") :name "purl")) " Picture Url"))))) else ; single line (html (:table (:tr ((:td :colspan 1) (:center "Your Name" ((:input :name "handle" :type "text" :size 20 :value (if* handle then handle else ""))) ((:input :name "send" :value "Post Message" :type "submit"))))) (:tr (:td ((:input :type "text" :name "body" :size 60 :maxsize 10000))))))))) )))))))) (defun chatenter-pic (req ent) ;; ;; this is the window where you enter the post and your handle. ;; this version is for when you post a picture ; (let* ((chat (chat-from-req req)) (user (user-from-req req)) (pp (or (request-query-value "pp" req) "*")) ; who to send to (ppp (request-query-value "ppp" req)) ; add a user to the dest (to-users (users-from-pstring pp)) (qstring)) (if* (or (null chat) (null user)) then (return-from chatenter-pic (ancient-link-error req ent))) (if* (eq (request-method req) :post) then (process-incoming-file chat req user to-users) (setf (request-method req) :get) (return-from chatenter-pic (chatenter req ent))) (let* () (setq qstring (add-secret req (add-user req (chat-query-string chat)))) ;; user must be true (setf (user-time user) (get-universal-time)) (if* ppp then ; add this user (setq pp (setf (user-to-users user) (concatenate 'string (or (user-to-users user) "") "," ppp))) (setq to-users (users-from-pstring pp)) elseif (equal pp "*") then (setf (user-to-users user) nil) else (setf (user-to-users user) pp)) ; now the logged in or not logged in check (if* (redir-check req ent chat nil) then (return-from chatenter-pic)) (with-http-response (req ent) (with-http-body (req ent) (html (:html ((:body :bgcolor (if* to-users then *bottom-frames-private* else *bottom-frames-bgcolor*)) ((:form :action (concatenate 'string "chatenter-pic?" (format nil "~a&pp=~a" qstring pp)) :method "POST" :enctype "multipart/form-data" ) (:center (html (:table (:tr (:td (:center ((:input :name "send" :value "Send" :type "submit")) " " (html (if* to-users then (html "Private msg from: ") else (html "From: ")) (:b (:princ-safe (user-handle user))) " to " (:b (if* to-users then (dolist (to-user to-users) (html (:princ-safe (user-handle to-user)) " " )) else (html "all")))) " -- " ((:a :href (format nil "chatlogin?~a" qstring) :target "_top") "Login") " --    " ((:input :name "send" :tabindex 2 :value "Send" :type "submit"))))) (:tr (:td "The picture file to upload (click Browse):" :br ((:input :type "file" :name "thefile" :size 40 :value "*.jpg"))) (:tr (:td "Add commments about your picture" :br ((:textarea :name "comments" :tabindex 1 :cols 50 :rows 3))))))))))))))))) (defparameter *pic-counter* 0) (defun process-incoming-file (chat req user to-users) (let ((comment "") type upload-pic) (loop (multiple-value-bind (kind name filename content-type) (parse-multipart-header (get-multipart-header req)) (case kind (:eof (return)) (:data ; must be contents (if* (equal name "comments") then (setq comment (get-all-multipart-data req)))) (:file (let ((contents (get-all-multipart-data req :type :binary :limit 2000000))) ; see if it ends in .jpg or .gif (if* (member content-type '("image/jpeg" "image/pjpeg" "image/jpg") :test #'equal) then (setq type "jpg") elseif (equal content-type "image/gif") then (setq type "gif") else (format t "uploaded type of ~s is ~s~%" filename content-type)) (if* type then (let ((filename (concatenate 'string (format nil "~x" (incf *chat-picname* 23)) "." type))) (with-open-file (p (concatenate 'string *chat-home-pics* "/" filename) :direction :output :if-exists :supersede) (write-sequence contents p)) (setq upload-pic `(:span :br ((:img :src ,(format nil "/chatpics/~a" filename))) :br)))))) (t (get-all-multipart-data req :limit 1000))))) (if* (or (and comment (> (length comment) 0)) upload-pic) then (add-chat-data chat req nil comment user to-users nil upload-pic)))) #+ignore (defun process-incoming-file (chat req user to-users) ;; read the multipart file, publish it ;; create the message referencing it, and then add that to the chat. (let (file content-type comment upload-pic) (loop (let ((h (get-multipart-header req))) (if* (null h) then (return)) (pprint h)(force-output) (let ((name (cdr (assoc "name" (cddr (assoc :param (cdr (assoc :content-disposition h :test #'eq)) :test #'eq)) :test #'equal)))) (if* (equal name "thefile") then ; the file we're uploading (setq content-type (cadr (assoc :content-type h :test #'eq))) (setq file (read-multipart-guts req)) elseif (equal name "comments") then ; read the comments (setq comment (octets-to-string (read-multipart-guts req))) else (read-multipart-guts req))))) ;; now we may have a picture (if* (and file content-type) then ; we have guts (let ((picname (format nil "/chatpix/~d~d" (get-universal-time) (incf *pic-counter*)))) (publish-multi :path picname :content-type content-type :items (list (list :binary file))) (setq upload-pic `(:span :br ((:img :src ,picname)) :br)) (setq comment (or comment "")))) (if* (and comment (> (length comment) 0)) then (add-chat-data chat req nil comment user to-users nil upload-pic)) )) (defun read-multipart-guts (req) (let ((buffer (make-array 40000 :element-type '(unsigned-byte 8))) (buffs) (total-size 0)) (loop (let ((count (get-multipart-sequence req buffer))) (if* count then (incf total-size count) (push (subseq buffer 0 count) buffs) else (return)))) (setq buffer (make-array total-size :element-type '(unsigned-byte 8))) (let ((count 0)) (dolist (buf (nreverse buffs)) (replace buffer buf :start1 count) (incf count (length buf)))) buffer)) (defun do-idle-timedout (req ent goback) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "timed out")) (:body "due to inactivity you have been timed out" :br (if* goback then (html "To return to the chat click " ((:a :href goback :target "_top") "here")))))))) (defun chatcontrol (req ent) ; control the updating (let ((chat (chat-from-req req)) (qstring)) (if* (null chat) then (return-from chatcontrol (ancient-link-error req ent))) (let* ((count (or (request-query-value "count" req) *default-count*)) (secs (or (request-query-value "secs" req) *default-secs*))) (setq qstring (add-lurk req (add-secret req (add-user req (chat-query-string chat))))) (with-http-response (req ent) (with-http-body (req ent) (html (:html ((:body :bgcolor *bottom-frames-bgcolor*) ((:form :action (concatenate 'string "chattop?" qstring ) :target "chattop" :method "POST") ((:input :type "text" :name "secs" :size 3 :value secs) "Seconds") :br ((:input :type "text" :name "count" :size 4 :value count)) "messages" :br ((:input :type "checkbox" :name "rv" :value "1")) " Reversed" :br ; use to distinguish a call to chattop from ; a user button click from a refresh one ((:input :type "hidden" :name "hitbut" :value "did")) ((:input :type "submit" :name "submit" :value "Update Messages")) ; optional chat transcript link (if* *offer-transcript* then (html :br :hr ((:a :href (format nil "chattranscript?~a" qstring) :target "_blank") "View transcript."))) ))))))))) (defun compute-integer-value (string) ;; compute the string to a number ;; if there's any junk return nil if we haven't seen good stuff yet (and (stringp string) (let ((ans 0)) (do ((i 0 (1+ i)) (end (length string)) (seen-digit) ) ((>= i end) (if* seen-digit then ans else nil)) (let ((digit (- (char-code (schar string i)) #.(char-code #\0)))) (if* (<= 0 digit 9) then (setq ans (+ (* ans 10) digit)) (setq seen-digit t) else (if* seen-digit then (return ans) else (return nil)))))))) (defun add-chat-data (chat req handle body user to-users purl upload-pic) ;; chat is chat object ;; req is http request object ;; handle is handle typed by user (only matters if user not logged in) ;; body is the string that's the posting ;; user is the user object if user is logged in ;; to-user is nil or the string naming the private message receipient ;; purl is picture url value (multiple-value-bind (prefix link) (if* (and (stringp purl) (not (equal "" purl))) then (scan-for-http purl)) (declare (ignore prefix)) (if* (stringp to-users) then ; just one user, turn it into a list (setq to-users (list to-users))) (if* link then (if* (and (consp link) (consp (car link)) (eq :img (caar link))) thenret ; valid image url else (setq link nil))) (if* (null link) then (setq link upload-pic)) (let* ((cvted-body (html-chk-string-to-lhtml body)) (ipaddr (socket:remote-host (request-socket req))) (dns (or #+ignore (socket:ipaddr-to-hostname ipaddr) (socket:ipaddr-to-dotted ipaddr))) (ut (get-universal-time)) (message (make-message :number (chat-message-number chat) :ipaddr ipaddr :dns dns :handle (if* user then (user-handle user) else handle) :to (if* to-users then (mapcar #'user-handle to-users) else t) :real (if* user then t else nil) :time (let ((time (compute-chat-date ut))) (if* *message-id-hook* then (funcall *message-id-hook* time) else time)) :ut ut :body (if* link then (cons link cvted-body) else cvted-body)))) (mp:with-process-lock ((chat-message-lock chat)) (add-chat-message chat message))))) (defun compute-chat-date (ut) ; return string to use as time for this message ; quick hack - hardwire in pdt (multiple-value-bind (sec min hour day month) (decode-universal-time ut) (format nil "~d:~2,'0d:~2,'0d Pacific Time, ~a ~d" hour min sec (month-name month) day ))) (defun month-name (month) (svref '#("" "Jan" "Feb" "Mar" "Apr" "May" "June" "July" "Aug" "Sep" "Oct" "Nov" "Dec") month)) (defun add-chat-message (chat message) ;; add the message to the messages of the chat. ;; assume that we've got the lock to do this. (let ((messages (chat-messages chat)) (message-next (chat-message-next chat))) (if* (>= message-next (length messages)) then ; must grow messages (let ((nmessages (make-array (+ (length messages) *msg-increment*)))) ;; copy only non-deleted messages (let ((to 0)) (dotimes (i (length messages)) (let ((message (svref messages i))) (if* (message-to message) then (setf (svref nmessages to) message) (incf to)))) (setq message-next to) (setf (chat-messages chat) nmessages) (setq messages nmessages)))) (setf (svref messages message-next) message) (setf (chat-message-next chat) (1+ message-next)) (setf (chat-message-number chat) (1+ (message-number message))))) (defun delete-chat-message (chat messagenum is-owner handle) ;; remove the message numbered messagenumy setting the to field to nil (mp:with-process-lock ((chat-message-lock chat)) (let ((message (find-chat-message chat messagenum))) (if* (and message (or is-owner ; owner can remove all (and handle (equal handle (message-handle message))))) then (setf (message-to message) nil) (push messagenum (chat-messages-deleted chat)))))) (defun delete-chat-message-by-message (chat message) ;; remove the given message by setting the to field to nil (mp:with-process-lock ((chat-message-lock chat)) (if* message then (setf (message-to message) nil) (push (message-number message) (chat-messages-deleted chat))))) (defun find-chat-message (chat number) ;; find the message with the given number (let* ((messages (chat-messages chat)) (len (and messages (chat-message-next chat))) (bottom 0) (top (and len (1- len))) ) (if* messages then ; find first message ; do binary search #+ignore (format t "Want message ~s~%" number) (loop (if* (> bottom top) then (return nil) ; no message found else (let ((try (truncate (+ top bottom) 2))) #+ignore (format t "try ~d (~d -> ~d)~%" try bottom top) (let ((message (svref messages try))) (if* message then #+ignore (format t "try msg num is ~s~%" (message-number message)) (if* (eql (message-number message) number) then #+ignore (format t "**found~%") (return message) elseif (< (message-number message) number) then ; in top quadrant (setq bottom (max (1+ bottom) try)) else (setq top (min (1- top) try))) else (warn "Null chat message at ~d" try) (return nil))))))))) (defun show-message-p (message handle) ;; return true if this message should be shown to someone with ;; the handle 'handle' ;; ;; handle is non-nil iff this person is logged in. ;; ;; message-to is nil if this is a deleted message in which case ;; no one should see it. ;; (or ; show everyone (eq t (message-to message)) ; message specifically to handle (and handle (member handle (message-to message) :test #'equal)) ; message from 'handle' and to at least one person (and (equal (message-handle message) handle) (message-to message)))) (defun find-nth-message (messages start handle count) ;; count down from start to find the index of the counth ;; message visible to handle. return that index (assert (> count 0)) (loop (if* (<= start 0) then (return 0)) (let ((message (svref messages start))) (if* (show-message-p message handle) then (if* (<= (decf count) 0) then (return start))) (decf start)))) (defun compute-chat-statistics (chat) ;; compute information about this chat (mp::with-process-lock ((chat-message-lock chat)) (let ((messages (chat-messages chat)) (message-next (chat-message-next chat))) (let ((total-messages 0) (private-messages 0)) (dotimes (i message-next) (let ((message (svref messages i))) (if* message then (if* (message-to message) then (incf total-messages) (if* (not (eq t (message-to message))) then (incf private-messages)))))) (values total-messages private-messages))))) (defun set-saved-chat-messages (chat count) ;; set to save approx 'count' messages (mp::with-process-lock ((chat-message-lock chat)) (let ((messages (chat-messages chat)) (message-next (chat-message-next chat))) ; count backwards until we've passed 'count' messages (do ((i (1- message-next) (1- i))) ((< i 0) ; no messages to remove nil) (let ((message (svref messages i))) (if* message then (if* (<= count 0) then ; remove all messages at this point (delete-chat-message-by-message chat message) else (if* (message-to message) then (decf count))))))))) (defun show-chat-info (chat count recent-first handle ownerp qstring) ;; show the messages for all and those private ones for handle ;; handle is only non-nil if this is a legit logged in handle (let ((message-next (chat-message-next chat)) (messages (chat-messages chat)) (first-message) (last-message) (nth-message) (message-increment) ) ;; if the person is not logged in then minimize the count (if* *restrict-messages* then (if* (null handle) then (setq count (min 5 count)) else (let ((user (user-from-handle handle))) (if* (and user (null (user-level user))) then (setq count (min 10 count)))))) (if* (zerop message-next) then (html (:b "There are no messages in this chat")) elseif (<= count 0) thenret ; nothing to show else ; starting at the end find the counth message (setq nth-message (find-nth-message messages (1- message-next) handle count)) (if* recent-first then (setq first-message (1- message-next) last-message nth-message message-increment -1) else (setq last-message (1- message-next) first-message nth-message message-increment 1)) (if* recent-first then ; tag most recent message (html ((:div :id "recent")))) (do ((i first-message (+ i message-increment))) (nil) (let ((message (svref messages i))) (if* (null message) then (warn "null message at index ~d" i) elseif (if* (or (eq t (message-to message)) (member handle (message-to message) :test #'equal)) then ;; to everyone or us nil ; don't skip elseif (and (equal (message-handle message) handle) (message-to message)) then ;; from us to someone, anyone nil ; don't skip else t ; skip ) thenret ; skip this message elseif (eq *show-style* 1) then (html :newline ((:font :color (if* (consp (message-to message)) then *private-font-color* else *public-font-color*)) (:b (:i (:princ-safe (message-handle message)))) (if* (not (message-real message)) then (html " (unverified)")) ((:font :size 1) " -- (" (:princ (message-time message)) (if* (consp (message-to message)) then (html " to: " (:princ-safe (message-to message)))) ")") " " (if* (or ownerp (and (message-real message) (equal (message-handle message) handle))) then (html ((:a :href (format nil "chattop?y=~a&~a" (message-number message) (or ownerp qstring))) "Delete"))) (if* ownerp then (let ((user (and (message-real message) (user-from-handle (message-handle message))))) (if* (and user (null (user-level user))) then ; can upgrade if desired (html " " ((:a :href (format nil "chattop?b=~a&~a" (user-ustring user) ownerp)) " Upgrade "))))) :newline :br (html-print-list (message-body message) *html-stream*) :br) :newline) else (html :newline ((:table :border 1 :width "100%" :frame "box") (:tr ((:td :width "10%") (:b (:i (:princ-safe (message-handle message)))) :br ((:font :size 1) (:princ (message-time message))) " " ) (:td (html-print-list (message-body message) *html-stream*))))))) (if* (eql i last-message) then (return))) (if* (not recent-first) then ; tag most recent message (html ((:div :id "recent"))))) (if* (null handle) then (html :br ((:table :border 1) (:tr (:td (if* *restrict-messages* then (html "In order to have access to the other facilities of this chat, " "such as private messaging and viewing the history of messages " "you must log in, by clicking on the Login link below.") else (html "In order to have access to the other facilities of this chat, " "such as private messaging " "you must log in, by clicking on the Login link below.") )))))) )) (defun chatlogin (req ent) ;; response function for /chatlogin?ucstring" (let ((chat (chat-from-req req))) (if* chat then (do-chat-login req ent (add-secret req (add-user req (chat-query-string chat))) nil) else (ancient-link-error req ent)))) (defun do-chat-login (req ent qstring failure) ;; put up a login screen for this chat (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head (:title "Login to Chat")) (:body (if* failure then (html (:blink (:b "Error: " (:princ-safe failure) :br :br)))) (:h1 "Login as an existing user") ((:form :action (format nil "chatlogincurrent?~a" qstring) :target "_top" :method "POST") ((:input :type "text" :size "15" :name "handle")) "Your Handle" :br ((:input :type "password" :size "15" :name "password")) "Your password" :br ((:input :type "submit" :name "submit" :value "login"))) :hr (:h1 "Create a new account and login") ((:form :action (format nil "chatloginnew?~a" qstring) :method "POST") ((:input :type "text" :size "15" :name "handle")) "Your Handle" :br ((:input :type "password" :size "15" :name "password")) "Your password" :br ((:input :type "password" :size "15" :name "password2")) "Type your password again" :br ((:input :type "submit" :name "submit" :value "New Account"))))))))) (defun chat-login-current (req ent) ;; handle a post to chatlogincurrent ; guard aginst (if* (not (eq :post (request-method req))) then (return-from chat-login-current (ancient-link-error req ent))) (let ((chat (chat-from-req req)) (handle (request-query-value "handle" req)) (password (request-query-value "password" req))) ; locate the handle (let ((user (find handle (users *master-controller*) :key #'user-handle :test #'equalp))) (if* (null user) then (return-from chat-login-current (do-chat-login req ent (add-secret req (add-user req (chat-query-string chat))) "That user name is unknown"))) (if* (not (equal password (user-password user))) then (return-from chat-login-current (do-chat-login req ent (add-secret req (add-user req (chat-query-string chat))) "That password is incorrect"))) ; worked, do a redirect (with-http-response (req ent :response *response-moved-permanently*) (setf (reply-header-slot-value req :location) (format nil "chat?~a&x=~a" (add-secret req (chat-query-string chat)) (user-ustring user))) (set-chat-cookie req (user-cookie user)) (with-http-body (req ent) (html "redirect")))))) (defun chatloginnew (req ent) ;; response function when a new user is being defined (if* (not (eq :post (request-method req))) then (return-from chatloginnew (ancient-link-error req ent))) (let* ((handle (request-query-value "handle" req)) (password (request-query-value "password" req)) (password2 (request-query-value "password2" req)) (chat (chat-from-req req)) (qstring (and chat (chat-query-string chat)))) (if* (null chat) then (return-from chatloginnew (ancient-link-error req ent))) (if* (equal "" password) then (return-from chatloginnew (do-chat-login req ent qstring "No password given"))) (if* (not (equal password password2)) then (return-from chatloginnew (do-chat-login req ent qstring "Passwords don't match"))) (dolist (user (users *master-controller*)) (if* (equalp (user-handle user) handle) then (return-from chatloginnew (do-chat-login req ent qstring "That user name exists")))) ; add new user (let (new-ustring new-pstring new-cookie) (mp:with-process-lock ((master-lock *master-controller*)) (loop (setq new-ustring (make-unique-string)) (setq new-pstring (make-unique-string)) (if* (dolist (user (users *master-controller*) t) (if* (or (equal new-ustring (user-ustring user)) (equal new-ustring (user-pstring user))) then ; already in use (return nil))) then (return))) ; leave the loop with new-ustring being unique among users (push (make-user :handle handle :password password :ustring new-ustring :pstring new-pstring :cookie (setq new-cookie (make-unique-string))) (users *master-controller*)) (dump-existing-chat *chat-home*)) ; go to the chat as the user (with-http-response (req ent :response *response-moved-permanently*) (setf (reply-header-slot-value req :location) (format nil "chat?~a&x=~a" (add-secret req qstring) new-ustring)) (set-chat-cookie req new-cookie) (with-http-body (req ent) "move to the chat"))))) (defun html-chk-string-to-lhtml (form) ;; look for {< to start html and >} to end it. ;; (multiple-value-bind (match full first quoted last) (match-regexp "\\(.*\\){<\\(.*\\)>}\\(.*\\)" form :newlines-special nil) (declare (ignore full)) (if* match then ; contains embedded html (append (string-to-lhtml first) (list quoted) (string-to-lhtml last)) else (string-to-lhtml form)))) (defun string-to-lhtml (form) ;; convert the string to a list of lhtml forms ;; ;; break the text into lines separated by :br's. ;; look for http://'s in the lines and replace them with ;; links or inline images (let (res (i 0) (start 0) (max (length form))) (loop ; we go around one last time when (eq i max) in which ; case we pretent there's a linefeed at the end (let ((ch (if* (>= i max) then #\linefeed else (schar form i)))) (if* (or (eq ch #\return) (eq ch #\linefeed)) then ; end of line (if* (not (eq start i)) then (let ((line (subseq form start i))) (loop (if* (or (null line) (equal line "")) then (return)) (multiple-value-bind (pref link rest) (scan-for-http line) (if* link then (push (de-angle pref) res) (push link res) (setq line rest) else (push (de-angle pref) res) (setq line nil)))))) (push :br res) (incf i) (if* (and (eq ch #\return) (< i max) (eq (schar form i) #\linefeed)) then (incf i) ; past following linefeed ) (setq start i) else (incf i)) (if* (> i max) then (return)))) (nreverse res))) (defun de-angle (str) ;; replace < and > in strings by their entity tags (if* (find #\< str) then (setq str (replace-regexp str "<" "<"))) (if* (find #\> str) then (setq str (replace-regexp str ">" ">"))) str) (defun scan-for-http (line) ;; look for http:// in the line and if found return it as ;; a link or image lhtml ;; (multiple-value-bind (ok whole) (match-regexp "http://[^ >]+" line :return :index) (if* ok then ; found one (let (http) (setq http (subseq line (car whole) (cdr whole))) (values ; value 1 -- everything before the http (subseq line 0 (car whole)) ; value 2 - the link (do ((i (1- (length http)) (1- i))) ((< i 0) ; didn't find a . .. set to a link `((:a :href ,http :target "_blank") (:princ-safe ,http))) (if* (eq (schar http i) #\.) then ; found a period (let ((type (subseq http (1+ i)))) (if* (member type '("gif" "jpg" "png") :test #'equalp) then ; an image link (return `((:img :src ,http))) else (setq i 0) ; stop search )))) ; value 3 - the rest of the line (subseq line (cdr whole)))) else line))) ;; chatmaster page (defun chatmaster (req ent) ;; commands ;; (let* ((chat (chat-from-req req)) (is-owner (equal (and chat (secret-key chat)) (request-query-value "s" req))) (act (request-query-value "act" req))) (if* (not is-owner) then (illegal-access req ent) (return-from chatmaster nil)) (if* (equal act "set-msg-count") then ; set the message count to the given value (let ((val (compute-integer-value (request-query-value "val" req)))) (if* (>= val 0) then (format t " set msg count to ~d~%" val) (set-saved-chat-messages chat val))) elseif (equal act "set-idle") then (let ((val (compute-integer-value (request-query-value "val" req)))) (if* (> val 0) then (format t " set idle timeout ~d mins~%" val) (setq *idle-timeout* (* 60 val)))) elseif (equal act "set-redirects") then (set-redirects req chat)) (if* (equal "yes" (request-query-value "shut" req)) then ; shutting down the chat (with-http-response (req ent) (with-http-body (req ent) (html (:body (:h1 "Shutdown"))))) (mp:process-run-function "killer" #'shutdown-chat) (sleep 10) (exit 0) (return-from chatmaster nil)) (multiple-value-bind (total-messages private-messages) (compute-chat-statistics chat) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head (:title "Chat Master")) (:body (:h2 "Statistics") "There are " (:princ total-messages) " messages in the chat and " (:princ private-messages) " of those are private" :br ((:form :method "POST") "Reduce the number of stored messages to " ((:input :type "text" :name "val" :value total-messages :size 6)) ((:input :type "hidden" :name "act" :value "set-msg-count")) ((:input :type "submit" :value "do it"))) :br (:h2 "Control") ((:form :method "POST") "Idle timeout in minutes: " ((:input :type "text" :name "val" :value (truncate *idle-timeout* 60) :size 4)) ((:input :type "hidden" :name "act" :value "set-idle")) ((:input :type "submit" :value "Set It"))) :br ((:form :method "POST") ((:input :type "checkbox" :name "shut" :value "yes")) "Shut down the chat " ((:input :type "submit" :value "really kill it"))) :br (show-redirects chat) ))))) ))) (defun show-redirects (chat) ;; display redirect dialog (html (:h2 "Redirects") ((:form :method "POST") ((:input :type "hidden" :name "act" :value "set-redirects")) ((:table :border 1) ; show current ones (dolist (redir (chat-redirects chat)) (html :newline (:tr (:td ((:input :type "text" :size 50 :name (redir-info-name redir) :value (redirect-info redir))) :br "ipaddr: " ((:input :type "text" :size 50 :name (redir-ipaddr-name redir) :value (socket:ipaddr-to-dotted (redirect-ipaddr redir)))) ", mask bits: " ((:input :type "text" :size 4 :name (redir-maskbits-name redir) :value (redirect-maskbits redir))) :br "to: " ((:input :type "text" :size 50 :name (redir-to-name redir) :value (redirect-to redir))) :br ((:input :type "checkbox" :if* (redirect-before redir) :checked "checked" :name (redir-before-name redir) :value "xxxx")) "applies only to people not logged on" :br ((:input :type "radio" :name (redir-state-name redir) :value "active" :if* (redirect-active redir) :checked "checked")) "On, " ((:input :type "radio" :name (redir-state-name redir) :value "disabled" :if* (not (redirect-active redir)) :checked "checked")) "Disabled, " ((:input :type "radio" :name (redir-state-name redir) :value "disrem")) "Disable then remove" :br "this rule used " (:princ-safe (redirect-use redir)) " time(s)" :br ((:input :type "checkbox" :name (redir-change-name redir) :value 0)) ((:font :color "red") "Make Changes") )))) ; show new one (html :newline (:tr (:td "info: " ((:input :type "text" :size 50 :name "newinfo")) :br "ipaddr:" ((:input :type "text" :size 50 :name "newipaddr")) ", mask bits" ((:input :type "text" :size 4 :name "newmask")) :br "redirect to: " ((:input :type "text" :size 50 :name "newto")) :br ((:input :type "checkbox" :name "newredirbefore" :value 0)) "applies only to people not logged on" :br ((:input :type "checkbox" :name "newdo" :value "1")) ((:font :color "red") "Add this entry"))))) ((:input :type "submit" :value "Change Redirects"))))) (defun set-redirects (req chat) ;; change the redirect information for this chat (let (changed) (dolist (redir (chat-redirects chat)) (if* (request-query-value (redir-change-name redir) req) then ; something changed in here (set-redir-info chat redir req (redir-info-name redir) (redir-ipaddr-name redir) (redir-maskbits-name redir) (redir-to-name redir) (redir-before-name redir) (redir-state-name redir)) (setq changed t))) (if* (request-query-value "newdo" req) then ; add a new entry (let ((redir (make-redirect))) (setf (redirect-index redir) (incf (redirect-counter chat))) (set-redir-info chat redir req "newinfo" "newipaddr" "newmask" "newto" "newredirbefore" "newxxxxxx") (setf (redirect-active redir) t) (setf (chat-redirects chat) (append (chat-redirects chat) (list redir))) (setq changed t) )) (if* changed then (dump-existing-chat *chat-home*)))) (defun set-redir-info (chat redir req ninfo nipaddr nmask nto nbefore nstate) (setf (redirect-info redir) (request-query-value ninfo req)) (let ((ipaddr (or (ignore-errors (socket:lookup-hostname (request-query-value nipaddr req))) 0))) (setf (redirect-ipaddr redir) ipaddr)) (let ((maskbits (or (compute-integer-value (request-query-value nmask req)) 32))) (setf (redirect-maskbits redir) maskbits) (setf (redirect-mask redir) (logand #xffffffff (ash -1 (- 32 maskbits)))) ) (setf (redirect-to redir) (request-query-value nto req)) (setf (redirect-before redir) (request-query-value nbefore req)) (let ((state (request-query-value nstate req))) (if* (equal state "active") then (setf (redirect-active redir) t) elseif (equal state "disabled") then (setf (redirect-active redir) nil) elseif (equal state "disrem") then ; eliminate (setf (chat-redirects chat) (delete redir (chat-redirects chat)))))) ;; generate temp names for form objects (defun redir-info-name (redir) (format nil "~a-info" (redirect-index redir))) (defun redir-ipaddr-name (redir) (format nil "~a-ipaddr" (redirect-index redir))) (defun redir-maskbits-name (redir) (format nil "~a-maskbits" (redirect-index redir))) (defun redir-before-name (redir) (format nil "~a-before" (redirect-index redir))) (defun redir-to-name (redir) (format nil "~a-to" (redirect-index redir))) (defun redir-change-name (redir) (format nil "~a-change" (redirect-index redir))) (defun redir-state-name (redir) (format nil "~a-state" (redirect-index redir))) ;; Chat archiver ;; ;; The chat archiver stores chat info to files (let (last-master-controller) (defun start-chat-archiver (master-controller) (and t (if* (not (eq master-controller last-master-controller)) then ; we've already started the process (setq last-master-controller master-controller) (mp:process-run-function "chat archiver" #'chat-archiver master-controller))))) (defun chat-archiver (master-controller) (let ((sleep-time 30) (did-work)) (loop (if* (not (eq *master-controller* master-controller)) then ; chat has been restarted, let this process die (return)) (format t "Chat archiver awoken~%") (setq did-work nil) ; write out the data (dolist (controller (controllers master-controller)) (dolist (chat (chats controller)) (mp:with-process-lock ((chat-message-lock chat)) (format t " arch ~d num ~d~%" (chat-message-archive chat) (chat-message-number chat)) (if* (or (< (chat-message-archive chat) (chat-message-number chat)) (chat-messages-deleted chat)) then ; must do work (archive-chat chat) (setq did-work t))))) ; adjust archive time so that we sleep longer when ; the chat is inactive. (if* did-work then (setq sleep-time 30) else (setq sleep-time (min (+ sleep-time 30) (* 30 60) ; 30 minutes ))) (format t "Chat archiver going to sleep~%") (sleep sleep-time)))) (defun find-index-of-message (chat number) ;; find index of message 'number' or the first one after that (let ((messages (chat-messages chat)) (message-next (chat-message-next chat))) (do ((i (1- message-next) (1- i))) ((< i 0) 0) (let* ((message (svref messages i)) (num (message-number message))) (if* (and num (< num number)) then (return (1+ i)) elseif (eql num number) then (return i)))))) (defun archive-chat (chat) ;; write out new messages for this chat ;; we are inside a process lock for this chat's message lock ;; so we can alter the fields at will (let ((messages (chat-messages chat)) (message-next (chat-message-next chat)) (message-archive (chat-message-archive chat))) ; we have to find the location of the ; message-archive message (if* (> message-next 0) then ; it better be greater than 0 since to be zero ; would be no messages stored ; locate the message numbered message-archive (let ((start-to-save (find-index-of-message chat message-archive))) (with-open-file (archive-port (archive-filename chat) :direction :output :if-exists :append :if-does-not-exist :create ;:external-foramt :utf-8 ) (do ((i start-to-save (1+ i))) ((>= i message-next)) (if* (eq t (message-to (svref messages i))) then ; a public message, archive it (pprint (svref messages i) archive-port)) ) (if* (chat-messages-deleted chat) then (pprint `(:delete ,@(chat-messages-deleted chat)) archive-port) (setf (chat-messages-deleted chat) nil))) (setf (chat-message-archive chat) (1+ (message-number (svref messages (1- message-next))))))))) (defun archive-filename (chat) (format nil "~a/~a" *chat-home* (chat-filename chat))) (defmethod set-style ((style color-style)) (setq *top-frame-bgcolor* (color-style-bgcolor style) *top-frame-font-color* (color-style-font-color style) *public-font-color* (color-style-font-color style) *top-frame-vlink-color* (color-style-vlink-color style) *top-frame-link-color* (color-style-link-color style) *top-frame-alink-color* (color-style-alink-color style))) (if* (not (boundp '*top-frame-bgcolor*)) then (set-style *normal-style*)) ;; for franz chats uncomment this since some people like this style better ;(set-style *white-style*) ;(setq *quick-return-path* "/xyzzy") ;-------- (defun chat-transcript (uc-string filename) ;; generate a transcript of the chat with the given uc-string ;; to the given filename ; ; find chat (let* ((query-alist (form-urlencoded-to-query uc-string)) (u (cdr (assoc "u" query-alist :test #'equalp))) (c (cdr (assoc "c" query-alist :test #'equalp)))) (let ((chat (dolist (controller (controllers *master-controller*)) (if* (equal u (ustring controller)) then (return (dolist (chat (chats controller)) (if* (equal c (ustring chat)) then (return chat)))))))) (if* (null chat) then (error "can't find chat with uc-string ~s" uc-string)) (with-open-file (*html-stream* filename :direction :output :if-exists :supersede ;:external-format :utf-8 ) (html (:head (:title "Transcript of " (:princ-safe (chat-name chat)))) (:body (:h1 "Transcript of " (:princ-safe (chat-name chat))) (show-chat-info chat (chat-message-next chat) nil nil nil nil))))))) ;; viewer tracking (defun track-viewer (chat user req) ;; note that this user/req has read the postings for this chat (let* ((time (get-universal-time)) (viewers (chat-viewers chat)) (ipaddr (socket:remote-host (request-socket req))) (empty-ent)) (mp::with-process-lock ((viewers-lock viewers)) ;; scan list of viewers. ;; set emptyent to the first viewent with a null time, thus meaning ;; it's a free entry ;; if an entry already exists for this user or ipaddr use it (dolist (viewent (viewers-list viewers) ; not there yet (if* empty-ent then ; replace old one (setf (viewent-time empty-ent) time (viewent-user empty-ent) user (viewent-ipaddr empty-ent) ipaddr (viewent-hostname empty-ent) nil) else (push (setq empty-ent (make-viewent :time time :user user :ipaddr ipaddr)) (viewers-list viewers)) )) (if* user then (if* (eq user (viewent-user viewent)) then ; update this one (setf (viewent-time viewent) time) (if* (not (eql ipaddr (viewent-ipaddr viewent))) then ; hmm, changed ipaddr (setf (viewent-ipaddr viewent) ipaddr (viewent-hostname viewent) nil)) (return)) else ; ipaddr test (if* (and (null (viewent-user viewent)) (eql ipaddr (viewent-ipaddr viewent))) then (setf (viewent-time viewent) time) (return))) (if* (null (viewent-time viewent)) then (if* (null empty-ent) then (setf empty-ent viewent)) elseif (> (- time (viewent-time viewent)) *max-active-time*) then ; this one is too old (setf (viewent-time viewent) nil) (if* (null empty-ent) then (setq empty-ent viewent))))))) (defun chatviewers (req ent) ;; display page of chat viewers (except us) (let* ((chat (chat-from-req req)) (user (user-from-req req)) (time (get-universal-time)) (is-owner (equal (and chat (secret-key chat)) (request-query-value "s" req))) (qstring) (viewers) (idletime) ) (if* (null chat) then (return-from chatviewers (ancient-link-error req ent))) (if* (and user (zerop (user-time user))) then (setf (user-time user) (get-universal-time))) (if* (> (setq idletime (- (get-universal-time) (user-time user))) (+ 10 *idle-timeout*)) then (do-idle-timedout req ent nil) (return-from chatviewers)) (setq qstring (add-secret req (add-user req (chat-query-string chat)))) (setq viewers (chat-viewers chat)) (setq idletime (truncate idletime 60)) ; cvt to minutes (with-http-response (req ent) (with-http-body (req ent) (html (:html ((:meta :http-equiv "Refresh" :content (format nil "30;url=chatviewers?~a" qstring))) (:body ((:font :size 2) ((:a :href (concatenate 'string "chatenter?pp=*&" qstring) :target "chatenter" ) "Send to All") :hr :newline (:pre (mp::with-process-lock ((viewers-lock viewers)) (dolist (viewent (viewers-list viewers)) (let* ((vtime (viewent-time viewent)) (vuser (viewent-user viewent)) (alive-time (if* vtime then (- time vtime))) (idle-time (if* vuser then (- time (or (user-time vuser) 0)) else 0))) (if* (and alive-time (> alive-time *max-active-time*)) then (setq vtime nil) (setf (viewent-time viewent) nil)) ; cvt to minutes (setq idle-time (min 120 (truncate idle-time 60))) (if* vtime then ; fill in the hostname if it's not there yet #+(and allegro (version>= 6 0)) (if* (null (viewent-hostname viewent)) then (setf (viewent-hostname viewent) (socket::dns-query (viewent-ipaddr viewent) :type :ptr :repeat 1 :timeout 0))) (if* (not (eq vuser user)) then ; list this one (if* vuser then (html ; link to add a user ((:a :href (format nil "chatenter?ppp=~a&~a" (user-pstring vuser) qstring) :target "chatenter") "(+)") " " ; link to create a private message ((:a :href (format nil "chatenter?pp=~a&~a" (user-pstring vuser) qstring) :target "chatenter" ) (:princ-safe (user-handle vuser)))) else ; ip address (html (:princ (or (viewent-hostname viewent) (socket:ipaddr-to-dotted (viewent-ipaddr viewent)))))) (html " (" (:princ (- time vtime)) "s)") (if* (> idle-time 2) then (html " [idle: " (:princ idle-time) "m] ")) (if* (or *show-machine-name-to-all* is-owner) then ; name then ip address (html " @" (:princ-safe (or (viewent-hostname viewent) (socket:ipaddr-to-dotted (viewent-ipaddr viewent)))))) (html :newline))))))))))))))) (defun chattranscript (req ent) (let* ((chat (or (chat-from-req req) (return-from chattranscript (ancient-link-error req ent)))) (title (format nil "full transcript of chat ~a as of ~a" (chat-name chat) (compute-chat-date (get-universal-time))))) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:title (:princ-safe title)) (:body (:h1 (:princ-safe title)) (let ((*top-frame-bgcolor* "#xffffff") ; white (*public-font-color* "#x000000") ; black ) (show-chat-info chat (chat-message-next chat) nil "bogushandle" nil nil)) ))))))) (defun redir-check (req ent chat before) ;; check if this request should be redirected ;; before is true if we are in the before login state (let ((redirects (chat-redirects chat))) (if* redirects then (let ((ipaddr (socket:remote-host (request-socket req)))) (dolist (redir redirects) (if* (and (redirect-active redir) (eq before (redirect-before redir)) (eql (logand (redirect-ipaddr redir) (redirect-mask redir)) (logand ipaddr (redirect-mask redir)))) then ; a match! (incf (redirect-use redir)) (with-http-response (req ent :response *response-moved-permanently*) (setf (reply-header-slot-value req :location) (redirect-to redir)) (with-http-body (req ent) (html "redirect"))) (return t))))))) ;;;;; chat test code ;; ;; (defun block-test (testers &rest args) (dotimes (i testers) (let ((name (format nil "tester-~d" i)) (delay (max 1 (random 10)))) (mp:process-run-function name #'(lambda () (apply #'test-chat :name name :delay delay args)))))) (defun test-chat (&key uc-string (count 100) (reads 5) (delay 2) (name "dummy1") (machine "localhost") (port 8000) (protocol :http/1.1)) (let ((reader-url (format nil "http://~a:~d/chattop?~a&~a" machine port uc-string (query-to-form-urlencoded `(("count" . 10) ("secs" . 5))))) (post-url (format nil "http://~a:~d/chatenter?~a" machine port uc-string))) (dotimes (i count) ; post first (let ((message (format nil "message ~d from ~a~%" i name))) (do-http-request post-url :protocol protocol :method :post :query `(("secs" . 5) ; not used ("handle" . ,name) ("body" . ,message))) (sleep delay) (dotimes (i reads) ; read it now (do-http-request reader-url :method :get :protocol protocol) (sleep delay)))))) ;;; fix up old chats (defun fixupchat () (setf (users *master-controller*) (nreverse (users *master-controller*))) (dolist (user (users *master-controller*)) (setf (user-ustring user) (make-unique-string)) (setf (user-pstring user) (make-unique-string))) (dump-existing-chat *chat-home*) ) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/examples.cl000066400000000000000000001132201133377100500252660ustar00rootroot00000000000000;; -*- mode: common-lisp; package: net.aserve.examples -*- ;; ;; examples.cl ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of ;; the GNU Lesser General Public License as published by ;; the Free Software Foundation; ;; ;; This code 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 ;; Lesser General Public License for more details. ;; ;; Version 2.1 of the GNU Lesser General Public License is in the file ;; license-lgpl.txt that was distributed with this file. ;; If it is not present, you can access it from ;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; ;; $Id: examples.cl,v 1.7 2004-01-27 10:53:44 rudi Exp $ ;; Description: ;; Allegro iServe examples ;;- This code in this file obeys the Lisp Coding Standard found in ;;- http://www.franz.com/~jkf/coding_standards.html ;;- ;; examples of web pages (defpackage #:net.aserve.examples ;; aserve example (:use #:common-lisp #:acl-compat.excl #:net.html.generator #:net.aserve)) (in-package #:net.aserve.examples) ;; don't flush all publishing done so far. since we have other ;; example files this is bad news. ; (unpublish :all t) (defparameter *example-pathname* *load-pathname*) ; where this file is (defmacro example-file (name) ;; create an absolute address for this file we'll load `(merge-pathnames ,name *example-pathname*)) (defvar *hit-counter* 0) (publish :path "/" :content-type "text/html" :function #'(lambda (req ent) ;(print (net.aserve::compute-request-headers req)) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Welcome to Portable AllegroServe on " (:princ (lisp-implementation-type)))) (:body (:center ((:img :src "aservelogo.gif"))) (:h1 "Welcome to Portable AllegroServe on " (:princ (lisp-implementation-type))) (:p "These links show off some of AllegroServe's capabilities. ") (:i "This server's host name is " (:princ-safe (header-slot-value req :host))) #+unix (:i ", the process id is " (:princ (net.aserve::getpid))) :br (:princ (incf *hit-counter*)) " hits" :p (:b "Sample pages") :br #+allegro ((:a :href "gc") "Garbage Collector Stats") :br ((:a :href "apropos") "Apropos") :br ((:a :href "pic") "Sample jpeg") :br ((:a :href "pic-redirect") "Redirect to previous picture") :br ((:a :href "pic-gen") "generated jpeg") "- hit reload to switch images" :br ((:a :href "pic-multi") "test of publish-multi") " - click more than once on this link" :br ((:a :href "cookietest") "test cookies") :br ((:a :href "secret") "Test manual authorization") " (name: " (:b "foo") ", password: " (:b "bar") ")" :br ((:a :href "secret-auth") "Test automatic authorization") " (name: " (:b "foo2") " password: " (:b "bar2") ")" :br ((:a :href "local-secret") "Test source based authorization") " This will only work if you can use " "http:://localhost ... to reach this page" :br ((:a :href "local-secret-auth") "Like the preceding but uses authorizer objects") :br ((:a :href "timeout") "Test timeout") " this will take a while to time out." :br ((:a :href "getfile-old") "Client to server file transfer") " - the old way" :br ((:a :href "getfile") "Client to server file transfer") " - the new way, with 1,000,000 byte file transfer limit" :br ((:a :href "missing-link") "Missing Link") " should get an error when clicked" :br #+unix (html ((:a :href "long-slow") "long, slow, cpu-bound") " action to demonstrate how AllegroServe " "in multiple Unix process mode can be responsive" " even if one AllegroServe process is wedged." " You probably do " (:b "not") " want to click on this link if you are running" " AllegroServe is its normal single Unix process" " mode.") :br ;; run only in an international lisp. ;; test at runtime since we may switch back ;; and forth between international and 8 bit ;; modes (if* (member :ics *features* :test #'eq) then (html :br ((:a :href "ichars") "International Character Display") :br ((:a :href "icharcount") "(International) Character Counter") :br ;; published in puzzle.cl ((:a :href "wordpuzzle") "Word Puzzle") :br ;; published in urian.cl ((:a :href "urian") "International Web Page Character Finder") :br ;; published in locale.cl ((:a :href "locale") "Locale Demo") :br )) #+(and unix (or (and allegro (version>= 6 1)) mcl)) (html "cgi tests: " ((:a :href "cgi0") "show environment") ", " ((:a :href "cgi1") "handle unix-style headers") ", " ((:a :href "cgi2") "redirect") ", " ((:a :href "cgi3") "set status to unauthorized request")) :hr ((:img :src "aservepowered.gif")) " <-- feel free to use this image on your AllegroServe-based web site" )))))) ;; a very simple page. This is so simple it doesn't put out the required ;; tags (like ) yet I suspect that most browsers will display it ;; correctly regardless. (publish :path "/hello" :content-type "text/html" :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html "Hello World!"))))) ;; this is the "/hello" example above modified to put out the correct ;; html tags around the page. (publish :path "/hello2" :content-type "text/html" :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:body "Hello World!"))))))) ;; display the current gc statistics. #+allegro (publish :path "/gc" :content-type "text/html" :function #'(lambda (req ent) (macrolet ((build-gsgc-table () `(html ,@(mapcar #'(lambda (kind) `(:tr (:td (:princ ,kind)) (:td (:princ-safe (sys:gsgc-parameter ,kind))))) '(:generation-spread :current-generation :tenure-limit :free-bytes-new-other :free-percent-new :free-bytes-new-pages :expansion-free-percent-new :expansion-free-percent-old :quantum ))))) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Allegro gc parameters")) (:body ((:table :bgcolor "silver" :bordercolor "blue" :border "3" :cellpadding "3" :cellspacing "3") (:tr (:td (:b "gsgc parameter")) (:td (:b "Value"))) (build-gsgc-table))))))))) ;; display a picture from a file. (publish-file :path "/pic" :file (example-file "prfile9.jpg") :content-type "image/jpeg") (publish-file :path "/aservelogo.gif" :file (example-file "aservelogo.gif") :content-type "image/gif") (publish-file :path "/aservepowered.gif" :file (example-file "aservepowered.gif") :content-type "image/gif") ;; this is a demonstration of how you can return a jpeg ;; image that was created on the fly (rather than read from ;; a file via publish-file). ;; We don't want to actually create the image here, so we ;; cheat and read it from a file, but it shows that you can ;; send any stream of bytes and they will be given the correct ;; mime type. ;; (publish :path "/pic-gen" :content-type "image/jpeg" :function (let ((selector 0)) ; chose one of two pictures #'(lambda (req ent) (with-http-response (req ent :format :binary) (with-http-body (req ent) ; here is where you would generate the picture. ; we're just reading it from a file in this example (let ((stream (request-reply-stream req))) (with-open-file (p (nth selector `(,(example-file "prfile9.jpg") ,(example-file "fresh.jpg"))) :element-type '(unsigned-byte 8)) (setq selector (mod (1+ selector) 2)) (loop (let ((val (read-byte p nil nil))) (if* (null val) then ;eof (return)) (write-byte val stream) ))))))))) ;; do a redirect to the picture (publish :path "/pic-redirect" :content-type "text/html" :function #'(lambda (req ent) (with-http-response (req ent :response *response-moved-permanently*) (setf (reply-header-slot-value req :location) "pic") (with-http-body (req ent) ;; this is optional and most likely unnecessary since most ;; browsers understand the redirect response (html (:html (:head (:title "Object Moved")) (:body (:h1 "Object Moved") "The picture you're looking for is now at " ((:a :href "pic") "This location")))))))) ;; this publish-multi example is simple but really doesn't show ;; the full power of publish-multi. ;; It doesn't show that we can include the contents of files ;; The :function case doesn't make use of the old cached value to ;; decide if it wants to return the old value or create a new one. (publish-multi :path "/pic-multi" :content-type "text/html" :items (list '(:string "The first line is constant
") (let (last-clicked) #'(lambda (req ent old-time cached-value) (declare (ignore req ent old-time cached-value)) (if* (null last-clicked) then (setq last-clicked (get-universal-time)) "this is your first click
" else (let* ((new (get-universal-time)) (diff (- new last-clicked))) (setq last-clicked new) (format nil "~d seconds since the last click
" diff))))) '(:string "The last line is constant"))) ;; ;; here's a form using the 'post' method ;; (publish :path "/tform" :content-type "text/html" :function (let ((name "unknown")) #'(lambda (req ent) (let ((body (get-request-body req))) (format t "got body ~s~%" body) (let ((gotname (assoc "username" (form-urlencoded-to-query body) :test #'equal))) (if* gotname then (setq name (cdr gotname))))) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "test form")) (:body "Hello " (:princ-safe name) ", " "Enter your name: " ((:form :action "/tform" :method "post") ((:input :type "text" :maxlength 10 :size 10 :name "username")))))))))) ;; example of a form that uses that 'get' method ;; (publish :path "/apropos" :content-type "text/html" :function #'(lambda (req ent) (let ((lookup (assoc "symbol" (request-query req) :test #'equal))) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Allegro Apropos")) ((:body :background "aserveweb/fresh.jpg") "New Apropos of " ((:form :action "apropos" :method "get") ((:input :type "text" :maxlength 40 :size 20 :name "symbol"))) #+allegro " The apropos function in ACL is case sensitive." :p (if* lookup then (html :hr (:b "Apropos") " of " (:princ-safe (cdr lookup)) :br :br) (let ((ans (apropos-list (cdr lookup)))) (if* (null ans) then (html "No Match Found") else (macrolet ((my-td (str) `(html ((:td :bgcolor "blue") ((:font :color "white" :size "+1") (:b ,str)))))) (html ((:table :bgcolor "silver" :bordercolor "blue" :border 3 :cellpadding 3 ) (:tr (my-td "Symbol") (my-td "boundp") (my-td "fboundp")) (dolist (val ans) (html (:tr (:td (:prin1-safe val)) (:td (:prin1 (and (boundp val) t))) (:td (:prin1 (and (fboundp val) t)))) :newline))))))) else (html "Enter name and type enter"))) :newline)))))) ;; a preloaded picture file (publish-file :path "/aserveweb/fresh.jpg" :file (example-file "fresh.jpg") :content-type "image/jpeg" :preload t) ;; a preloaded text file (publish-file :path "/foo" :file (example-file "foo.txt") :content-type "text/plain" :preload t) (publish-file :path "/foo.txt" :file (example-file "foo.txt") :content-type "text/plain" :preload nil) ;; some entries for benchmarking (publish-file :path "/file2000" :file (example-file "file2000.txt") :content-type "text/plain" :preload nil) (publish-file :path "/file2000-preload" :file (example-file "file2000.txt") :content-type "text/plain" :preload t) (publish :path "/dynamic-page" :content-type "text/plain" :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html "This is a dynamic page"))))) ;; an example which causes the web browser to put up the ;; name/password box and if you enter the name "foo" and password "bar" ;; then you get access to the secret info. (publish :path "/secret" :content-type "text/html" :function #'(lambda (req ent) (multiple-value-bind (name password) (get-basic-authorization req) (if* (and (equal name "foo") (equal password "bar")) then (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Secret page")) (:body "You made it to the secret page")))) else (with-http-response (req ent :response *response-unauthorized*) (set-basic-authorization req "secretserver") (with-http-body (req ent) (html (:h1 "You Failed") "You failed to enter the correct name/password") )))))) (publish :path "/local-secret" :content-type "text/html" :function #'(lambda (req ent) (let ((net-address (ash (socket:remote-host (request-socket req)) -24))) (if* (equal net-address 127) then (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Secret page")) (:body (:b "Congratulations. ") "You are on the local network")))) else (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head (:title "Unauthorized")) (:body "You cannot access this page " "from your location"))))))))) (publish :path "/local-secret-auth" :content-type "text/html" :authorizer (make-instance 'location-authorizer :patterns '((:accept "127.0" 8) :deny)) :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Secret page")) (:body (:b "Congratulations. ") "You made it to the secret page")))))) ;; these two urls show how to transfer a user-selected file from ;; the client browser to the server. ;; ;; We use two urls (/getfile to put up the form and /getfile-post to ;; handle the post action of the form). We could have done it all ;; with one url but since there's a lot of code it helps in the ;; presentation to separate the two. ;; (publish :path "/getfile-old" :content-type "text/html; charset=utf-8" :function #'(lambda (req ent) (getfile-function req ent "/getfile-got-old"))) (publish :path "/getfile" :content-type "text/html; charset=utf-8" :function #'(lambda (req ent) (getfile-function req ent "/getfile-got"))) (defun getfile-function (req ent posturl) (with-http-response (req ent) (with-http-body (req ent) (html (:head "get file") (:body ((:form :enctype "multipart/form-data" :method "post" :action posturl) "Let me know what file to grab" :br ((:input :type "file" :name "thefile" :value "*.txt")) :br ((:input :type "text" :name "textthing")) "Enter some text" :br ((:input :type "checkbox" :name "checkone")) "check box one" :br ((:input :type "checkbox" :name "checktwo")) "check box two" :br ((:input :type "submit")))))))) (publish :path "/secret-auth" :content-type "text/html" :authorizer (make-instance 'password-authorizer :allowed '(("foo2" . "bar2") ("foo3" . "bar3") ) :realm "SecretAuth") :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Secret page")) (:body "You made it to the secret page")))))) ;; ;; this demonstrates the use of the low level multipart access functions. ;; In this code we parse the result of get-multipart-header ourselves ;; and we use get-multipart-sequence. ;; In the example that follows (associate with path "/getfile-got") ;; we show now to use the higher level functions to retrive multipart ;; data (publish :path "/getfile-got-old" :content-type "text/html; charset=utf-8" :function #'(lambda (req ent) (with-http-response (req ent) (let ((h nil) (files-written) (text-strings) ) (loop ; get headers for the next item (if* (null (setq h (get-multipart-header req))) then ; no more items (return)) ; we can get the filename from the header if ; it was an item. If there is ; no filename, we just create one. (pprint h) (pprint (multiple-value-list (parse-multipart-header h))) (let ((cd (assoc :content-disposition h :test #'eq)) (filename) (sep)) (if* (and cd (consp (cadr cd))) then (setq filename (cdr (assoc "filename" (cddr (cadr cd)) :test #'equalp))) (if* filename then ;; locate the part of the filename ;; after the last directory separator. ;; the common lisp pathname functions are ;; no help since the filename syntax ;; may be foreign to the OS on which ;; the server is running. (setq sep (max (or (position #\/ filename :from-end t) -1) (or (position #\\ filename :from-end t) -1))) (setq filename (subseq filename (1+ sep) (length filename))))) (if* (and filename (not (equal filename ""))) then (push filename files-written) (with-open-file (pp filename :direction :output :if-exists :supersede :element-type '(unsigned-byte 8)) (format t "writing file ~s~%" filename) (let ((buffer (make-array 4096 :element-type '(unsigned-byte 8)))) (loop (let ((count (get-multipart-sequence req buffer))) (if* (null count) then (return)) (write-sequence buffer pp :end count))))) elseif (null filename) then ; no filename, just grab as a text ; string (let ((buffer (make-string 1024))) (loop (let ((count (get-multipart-sequence req buffer :external-format :utf8-base))) (if* count then (push (subseq buffer 0 count) text-strings) else (return)))))))) ;; now send back a response for the browser (with-http-body (req ent :external-format :utf8-base) (html (:html (:head (:title "form example")) (:body "-- processed the form, files written --" (dolist (file (nreverse files-written)) (html :br "file: " (:b (:prin1-safe file)))) :br "-- Non-file items Returned: -- " :br (dolist (ts (reverse text-strings)) (html (:princ-safe ts) :br)))))))))) ;; ;; this retrieves data from a multipart form using the high level ;; functions. You can compare this code to that above to see which ;; method you prefer ;; (publish :path "/getfile-got" :content-type "text/html; charset=utf-8" :function #'(lambda (req ent) (with-http-response (req ent) (let ((files-written) (text-strings) (overlimit) ) (loop (multiple-value-bind (kind name filename content-type) (parse-multipart-header (get-multipart-header req)) (case kind (:eof (return)) ; no more to read (:data (push (cons name (get-all-multipart-data req)) text-strings)) (:file (let ((contents (get-all-multipart-data req :type :binary :limit 1000000 ; abitrary limit ))) ; find the tail of the filename, can't use ; lisp pathname code since the filename syntax ; may not correspond to this lisp's native os (let ((sep (max (or (position #\/ filename :from-end t) -1) (or (position #\\ filename :from-end t) -1)))) (if* sep then (setq filename (subseq filename (1+ sep))))) (if* (eq contents :limit) then ; tried to give us too much (setq overlimit t) elseif (equal filename "") ; no file given thenret ; ignore else (with-open-file (p filename :direction :output :if-exists :supersede :element-type '(unsigned-byte 8)) (format t "writing file ~s, content-type ~s~%" filename content-type) (push filename files-written) (write-sequence contents p))))) (t ; all else ignore but read to next header (get-all-multipart-data req :limit 1000))))) ;; now send back a response for the browser (with-http-body (req ent :external-format :utf8-base) (html (:html (:head (:title "form example")) (:body "-- processed the form, files written --" (dolist (file (nreverse files-written)) (html :br "file: " (:b (:prin1-safe file)))) (if* overlimit then (html :br "File given was over our " "limit in the size we " "will accept")) :br "-- Non-file items Returned: -- " :br (dolist (ts (reverse text-strings)) (html "item name: " (:princ-safe (car ts)) ", item value: " (:princ-safe (cdr ts)) :br)))))))))) (publish :path "/cookietest" :content-type "text/html" :function #'(lambda (req ent) (with-http-response (req ent) (set-cookie-header req :name "froba" :value "vala" :path "/" :expires :never) (set-cookie-header req :name "frob2" :value "val2" :path "/" :expires :never) (set-cookie-header req :name "frob3-loooooooooooooong" :value "val3-loooooooooooooong" :path "/" :expires :never) (set-cookie-header req :name "the time" :value (net.aserve::universal-time-to-date (get-universal-time)) :path "/cookieverify" :expires (+ (get-universal-time) (* 20 60) ; 20 mins ) ) (with-http-body (req ent) (html (:head (:title "Cookie Test")) (:body "you should have a cookie now." " Go " ((:a :href "cookieverify") "here") " to see if they were saved")))))) (publish :path "/cookieverify" :content-type "text/html" :function #'(lambda (req ent) (let ((cookie-info (get-cookie-values req))) (with-http-response (req ent) (with-http-body (req ent) (html (:head (:title "Cookie results")) (:body "The following cookies were returned: " (:prin1-safe cookie-info)))))))) (publish :path "/timeout" :content-type "text/html" :function #'(lambda (req ent) ;; do nothing interesting so that the timeout will ;; occur (with-http-response (req ent :timeout 15) (loop (sleep 5))))) (publish :path "/long-slow" :content-type "text/plain" :function #'(lambda (req ent) ;; chew up cpu time in a look that blocks ;; the scheduler from running so this aserve ;; won't accept any more connections and we can ;; demo the multiple process version ; takes 50 secs on a 1.2ghz Athlon (locally (declare (optimize (speed 3) (safety 0))) (dotimes (aa 500) (declare (fixnum aa)) (dotimes (j 300) (declare (fixnum j)) (dotimes (i 10000) (declare (fixnum i)) (let ((k (+ i j))) (declare (fixnum k)) (setf k (- i j)) (setf k (+ i j k)) (setf k (- i j k))))))) (with-http-response (req ent) (with-http-body (req ent) (html "done"))))) ;; cgi publishing, we publish a shell script that only works ;; on Unix shells: #+unix (publish :path "/cgi0" :function #'(lambda (req ent) (net.aserve::run-cgi-program req ent "aserve/examples/cgitest.sh" :env '(("HTTP_CONNECTION" . "hack replaced value") ("NewHead" . "NewVal"))))) #+unix (publish :path "/cgi1" :function #'(lambda (req ent) (net.aserve::run-cgi-program req ent "aserve/examples/cgitest.sh 1"))) #+unix (publish :path "/cgi2" :function #'(lambda (req ent) (net.aserve::run-cgi-program req ent "aserve/examples/cgitest.sh 2"))) #+unix (publish :path "/cgi3" :function #'(lambda (req ent) (net.aserve::run-cgi-program req ent "aserve/examples/cgitest.sh 3"))) ;;;;;; directory publishing. These will only work on a particular ;; set of machines so you'll have to modify them to point to an ;; existing tree of pages on your machine if you want to see this work. ;; the franz home page #+ignore (publish-directory :prefix "/" :destination "/net/tanya/home/httpd/html/" ) #+ignore (publish-directory :prefix "/int" :destination "/net/tanya/www/internal/htdocs/") ;; a separate world: (defparameter *server2* (make-instance 'wserver)) (publish-directory :server *server2* :prefix "/" :destination "/home/httpd/html/") ;; ;; International Characters ;; (publish :path "/icharcount" :content-type "text/html; charset=utf-8" :function #-(and allegro ics (version>= 6 0)) #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (princ #.(format nil "~ This page available only with International Allegro CL post 6.0 beta") *html-stream*)))) #+(and allegro ics (version>= 6 0)) #'(lambda (req ent) (let* ((body (get-request-body req)) (text (if* body then (cdr (assoc "quotation" (form-urlencoded-to-query body :external-format :utf8-base) :test #'equal))))) (with-http-response (req ent) (with-http-body (req ent :external-format :utf8-base) (if* text then ;; got the quotation, analyze it (let ((results (analyze-text text))) (html (:html (:head (:title "Character Counts")) (:body (html (:pre (:princ-safe text))) (:p "Quote by Character Names:") (:table (dotimes (i (length text)) (html (:tr (:td (:princ (schar text i))) (:td (:prin1 (schar text i))))))) (:p "Sorted by occurrence:") ((:table :border 1) (dolist (r results) (html (:tr (:td (:princ (format nil "u+~4,'0x" (char-code (car r))))) (:td (:princ (car r))) (:td (:prin1 (car r))) (:td (:princ (cdr r))))))))))) else ;; ask for quotation (html (:html (:head (:title "Character Counter")) (:body ((:form :action "icharcount" :method "POST") (:h1 "AllegroServe Demo") (:p #.(format nil "~ Below are links containing international character samples you can use to copy and paste into the following form. Note that even characters that don't display (due to missing fonts) can still be copied and pasted into the form below.")) (:ul (:li ((:a href #.(format nil "~ http://www.columbia.edu/kermit/utf8.html") target "_blank") "UTF-8 Sampler")) (:li ((:a href #.(format nil "~ http://www.trigeminal.com/samples/provincial.html") target "_blank") #.(format nil "~ The \"anyone can be provincial!\" page")))) "Enter your favorite quote:" :br ((:textarea :name "quotation" :rows 15 :cols 50)) :br ((:input :type "submit" :value "count it")))))))))))) (defun analyze-text (text) (let ((char-ht (make-hash-table)) (results nil)) (dotimes (i (length text)) (let ((ch (schar text i))) (if* (gethash ch char-ht) then (incf (gethash ch char-ht)) else (setf (gethash ch char-ht) 1)))) (maphash #'(lambda (k v) (push (cons k v) results)) char-ht) (sort results #'(lambda (x y) (> (cdr x) (cdr y)))))) (publish :path "/ichars" :content-type "text/html" :function #-(and allegro ics (version>= 6 0)) #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (princ #.(format nil "~ This page available only with International Allegro CL post 6.0") *html-stream*)))) ;; Need pre-final.1's :try-variant change to find-external-format #+(and allegro ics (version>= 6 0)) #'(lambda (req ent) (let* ((body (get-request-body req)) (query (if* body then (form-urlencoded-to-query body))) (lisp-ef (or (if* query then (cdr (assoc "lisp-ef" query :test #'equal))) ":utf8")) (http-charset (or (if* query then (cdr (assoc "http-charset" query :test #'equal))) "utf-8")) (http-content-type (format nil "text/html; charset=~a" http-charset))) (setq lisp-ef (or (read-from-string lisp-ef) :latin1-base)) (with-http-response (req ent) (with-http-body (req ent :external-format (crlf-base-ef (find-external-format lisp-ef :try-variant t))) (html (:html (:head (:title (:princ-safe (format nil "Character Display: ~a / ~a" lisp-ef http-charset))) ((:meta http-equiv "content-type" content http-content-type))) (:body ((:form :action "ichars" :method "POST") "HTTP content-type: " (:strong (:prin1 http-content-type)) :br "with-http-body's external-format: " (:strong (:prin1 lisp-ef)) :br :br "Note that the way characters are displayed depends upon " "the browser's fonts, and how the browser interprets " "the HTTP content-type." :br :br (:center ((:table :border 1 :cellpadding 2) (:tr (:th "Charset") (:th "Lisp Character") (:th "Display")) (:tr (:td "Latin-1")) (:tr (:td "Latin-1") (:td (:prin1 #\a)) (:td (:princ #\a))) (:tr (:td "Latin-1") (:td (:prin1 #\b)) (:td (:princ #\b))) (:tr (:td "Latin-1") (:td (:prin1 #\c)) (:td (:princ #\c))) (:tr (:td "Latin-1") (:td (:prin1 #\cent_sign)) (:td (:princ #\cent_sign))) (:tr (:td "Latin-1") (:td (:prin1 #\pound_sign)) (:td (:princ #\pound_sign))) (:tr (:td "Latin-1") (:td (:prin1 #\latin_small_letter_thorn)) (:td (:princ #\latin_small_letter_thorn))) (:tr (:td "Latin-1") (:td (:prin1 #\latin_capital_letter_ae)) (:td (:princ #\latin_capital_letter_ae))) (:tr (:td "Latin-1") (:td (:prin1 #\latin_capital_letter_thorn)) (:td (:princ #\latin_capital_letter_thorn))) (:tr (:td "Latin-1") (:td (:prin1 #\latin_capital_letter_i_with_circumflex)) (:td (:princ #\latin_capital_letter_i_with_circumflex))) (:tr (:td "Latin-2")) (:tr (:td "Latin-2") (:td (:prin1 #\latin_small_letter_u_with_ring_above)) (:td (:princ #\latin_small_letter_u_with_ring_above))) (:tr (:td "Latin-2") (:td (:prin1 #\latin_capital_letter_n_with_caron)) (:td (:princ #\latin_capital_letter_n_with_caron))) (:tr (:td "Latin-2") (:td (:prin1 #\latin_capital_letter_l_with_stroke)) (:td (:princ #\latin_capital_letter_l_with_stroke))) (:tr (:td "Latin-3")) (:tr (:td "Latin-3") (:td (:prin1 #\latin_small_letter_j_with_circumflex)) (:td (:princ #\latin_small_letter_j_with_circumflex))) (:tr (:td "Latin-3") (:td (:prin1 #\latin_capital_letter_h_with_stroke)) (:td (:princ #\latin_capital_letter_h_with_stroke))) (:tr (:td "Latin-3") (:td (:prin1 #\latin_capital_letter_c_with_circumflex)) (:td (:princ #\latin_capital_letter_c_with_circumflex))) (:tr (:td "Latin-4")) (:tr (:td "Latin-4") (:td (:prin1 #\latin_small_letter_u_with_ogonek)) (:td (:princ #\latin_small_letter_u_with_ogonek))) (:tr (:td "Latin-4") (:td (:prin1 #\latin_capital_letter_i_with_macron)) (:td (:princ #\latin_capital_letter_i_with_macron))) (:tr (:td "Latin-4") (:td (:prin1 #\latin_capital_letter_g_with_cedilla)) (:td (:princ #\latin_capital_letter_g_with_cedilla))) (:tr (:td "Latin-5")) (:tr (:td "Latin-5") (:td (:prin1 #\cyrillic_capital_letter_ukrainian_ie)) (:td (:princ #\cyrillic_capital_letter_ukrainian_ie))) (:tr (:td "Latin-5") (:td (:prin1 #\cyrillic_small_letter_nje)) (:td (:princ #\cyrillic_small_letter_nje))) (:tr (:td "Latin-5") (:td (:prin1 #\cyrillic_capital_letter_ya)) (:td (:princ #\cyrillic_capital_letter_ya))) (:tr (:td "Latin-6")) (:tr (:td "Latin-6") (:td (:prin1 #\arabic_letter_feh)) (:td (:princ #\arabic_letter_feh))) (:tr (:td "Latin-6") (:td (:prin1 #\arabic_letter_hah)) (:td (:princ #\arabic_letter_hah))) (:tr (:td "Latin-6") (:td (:prin1 #\arabic_letter_yeh_with_hamza_above)) (:td (:princ #\arabic_letter_yeh_with_hamza_above))) (:tr (:td "Latin-7")) (:tr (:td "Latin-7") (:td (:prin1 #\greek_capital_letter_delta)) (:td (:princ #\greek_capital_letter_delta))) (:tr (:td "Latin-7") (:td (:prin1 #\greek_small_letter_eta)) (:td (:princ #\greek_small_letter_eta))) (:tr (:td "Latin-7") (:td (:prin1 #\greek_capital_letter_sigma)) (:td (:princ #\greek_capital_letter_sigma))) (:tr (:td "Latin-8")) (:tr (:td "Latin-8") (:td (:prin1 #\hebrew_letter_alef)) (:td (:princ #\hebrew_letter_alef))) (:tr (:td "Latin-8") (:td (:prin1 #\hebrew_letter_bet)) (:td (:princ #\hebrew_letter_bet))) (:tr (:td "Latin-8") (:td (:prin1 #\hebrew_letter_gimel)) (:td (:princ #\hebrew_letter_gimel))) (:tr (:td "Latin-15")) (:tr (:td "Latin-15") (:td (:prin1 #\latin_small_ligature_oe)) (:td (:princ #\latin_small_ligature_oe))) (:tr (:td "Latin-15") (:td (:prin1 #\latin_capital_ligature_oe)) (:td (:princ #\latin_capital_ligature_oe))) (:tr (:td "Japanese")) (:tr (:td "Japanese") (:td (:prin1 #\hiragana_letter_a)) (:td (:princ #\hiragana_letter_a))) (:tr (:td "Japanese") (:td (:prin1 #\hiragana_letter_i)) (:td (:princ #\hiragana_letter_i))) (:tr (:td "CJK")) (:tr (:td "CJK") (:td (:prin1 #\cjk_compatibility_ideograph-f900)) (:td (:princ #\cjk_compatibility_ideograph-f900))) (:tr (:td "CJK") (:td (:prin1 #\cjk_compatibility_ideograph-f901)) (:td (:princ #\cjk_compatibility_ideograph-f901))) (:tr (:td "CJK") (:td (:prin1 #\cjk_compatibility_ideograph-f902)) (:td (:princ #\cjk_compatibility_ideograph-f902))) (:tr (:td "Ligature")) (:tr (:td "Ligature") (:td (:prin1 #\latin_small_ligature_fi)) (:td (:princ #\latin_small_ligature_fi))) (:tr (:td "Ligature") (:td (:prin1 #\latin_small_ligature_fl)) (:td (:princ #\latin_small_ligature_fl))) )) :br :br (:princ-safe (format nil "~ Switch Lisp External-Format (Current is ~s): " (ef-name (find-external-format lisp-ef)))) ((:select name "lisp-ef") ((:option value ":utf8-base" :selected "selected") ":utf8-base") ((:option value ":iso8859-1") ":iso8859-1") ((:option value ":iso8859-2") ":iso8859-2") ((:option value ":iso8859-3") ":iso8859-3") ((:option value ":iso8859-4") ":iso8859-4") ((:option value ":iso8859-5") ":iso8859-5") ((:option value ":iso8859-6") ":iso8859-6") ((:option value ":iso8859-7") ":iso8859-7") ((:option value ":iso8859-8") ":iso8859-8") ((:option value ":iso8859-15")":iso8859-15") ((:option value ":shiftjis") ":shiftjis") ((:option value ":euc") ":euc") ((:option value ":932") ":932 (Windows 932)") ((:option value ":1250") ":1250 (Windows 1250)") ((:option value ":1254") ":1254 (Windows 1254)") ((:option value ":1251") ":1251 (Windows 1251)") ((:option value ":1255") ":1255 (Windows 1255)") ) :br (:princ-safe (format nil "~ Switch HTTP Charset: (Current is ~s): " http-charset)) ((:select name "http-charset") ((:option value "utf-8" :selected "selected") "utf-8") ((:option value "iso-8859-1") "iso-8859-1") ((:option value "iso-8859-2") "iso-8859-2") ((:option value "iso-8859-3") "iso-8859-3") ((:option value "iso-8859-4") "iso-8859-4") ((:option value "iso-8859-5") "iso-8859-5") ((:option value "iso-8859-6") "iso-8859-6") ((:option value "iso-8859-7") "iso-8859-7") ((:option value "iso-8859-8") "iso-8859-8") ((:option value "iso-8859-15") "iso-8859-15") ((:option value "shift_jis") "shift_jis") ((:option value "euc-jp") "euc-jp") ((:option value "windows-932") "windows-932") ((:option value "windows-1250") "windows-1250") ((:option value "windows-1254") "windows-1254") ((:option value "windows-1251") "windows-1251") ((:option value "windows-1255") "windows-1255") ) :br :br ((:input :type "submit" :value "Redisplay"))))))) )))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/file2000.txt000066400000000000000000000037201133377100500251150ustar00rootroot00000000000000this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this is a sample file of roughly 2000 bytes used to do benchmarks on the retrieval speed of AllegroServe this cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/foo.txt000066400000000000000000000001441133377100500244540ustar00rootroot00000000000000this is a test of returning a text file and now this is it for the file next line and one more line cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/fresh.jpg000066400000000000000000000333471133377100500247540ustar00rootroot00000000000000ÿØÿàJFIFHHÿí ¨Photoshop 3.08BIMíHH8BIM x8BIMó8BIM 8BIM' 8BIMõH/fflff/ff¡™š2Z5-8BIMøpÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿè8BIM@@8BIM8BIM pTPn@ûÿØÿàJFIFHHÿîAdobed€ÿÛ„            ÿÀTp"ÿÝÿÄ?   3!1AQa"q2‘¡±B#$RÁb34r‚ÑC%’Sðáñcs5¢²ƒ&D“TdE£t6ÒUâeò³„ÃÓuãóF'”¤…´•ÄÔäô¥µÅÕåõVfv†–¦¶ÆÖæö7GWgw‡—§·Ç×ç÷5!1AQaq"2‘¡±B#ÁRÑð3$bár‚’CScs4ñ%¢²ƒ&5ÂÒD“T£dEU6teâò³„ÃÓuãóF”¤…´•ÄÔäô¥µÅÕåõVfv†–¦¶ÆÖæö'7GWgw‡—§·ÇÿÚ ?êv… Ô£AðRh•õØÒUÁ5´ø„›ùJÖ¥€ÒÏꄉ¥-ÔÙÖñØ«ù·×Žö±Ìsœñ#hùj³_Ô1Ü`1Àð8DãBƒ†éÀŸ¹J4'Ç_½¬*múq³Ã¾Ôà´´Ú-IxñŸr†ÖkisA$I'T7±Î`N¼öF© kv™kuD §ªÆ0ûAþOµ]ªçžIøýJ¥UOsCõÀ`ðQ;÷§Ð[e¹fEa{AÚbH™ÕdÕé2mlí¨æ*m!aÔ4x"6°òÚ>à…YÿÐíKA‰ð”¨€øßüª¤ù(ׯXü¥jÐà)®LH|V[?‰Z4i`0@")ÌúÂÒn ƒ®Çiß²Zý¿D|IԭαE6ŠŸi2ÒZÐ Lû¿ïª€Ä¨ÃX,.qÍÜfgÙ¤{‘Ž¡i4i¸6|›ÿQZø^HöÇá Óh³ÞÀÒv–Ž<Ä'Öæ]/ii À=àvFÔBÌc}"Ýb~ZˆGlî æ‘&ïÌþoûHÇK •ÍÍÈ—l—kìoî²ÚÑsÅ÷m-@‡Øö5¾ßnÕN\ÙåÚêF¿šßŠCÛQx1-0eŽŸk†ïš( ·dRY'èj\ñ liîÜ?”ˆ÷cgC Û¡•™Ž÷ú¬¯aÔ¼ à7ùuÿÁíý½}µVE¡£¹ó~Ý©E(°nᤖó¤ÿìÜ¢HxyKõ‘¬ÇõÛüŸõjͨ‡ísƒdhHúvùÛvþ~Õ7ƒ >¡Ø†–6ïão»÷SíÝ{¿BNæ¹Ú’H|þÓB˵Õ^Ò Ú\âcI‘îþ·ï(áŒ@~ø:¸¸œ¸<§z†I$Èî}®öû5U?ÿÒíéøŽê¶MpA$˜ükx é¸Nž%ûÈÛÛB¢;/Ú^Y¹ÛgVÉó~Š‘s~‘ú pdNßs}Êê~?Á9ArƒY¤‚@ÙãaS¯ VØßdaÐ ýévåZ ?8§Ü~Üœ„Ž°[fç0—7½åÎõ)Ý—’ö‰t µfÝ"FÏú”6G¨#S®Ÿ$Õ‡<Ù[¼v ƒôZ?{TÙ£}´XK·89¢è:þæå+Úö9‘¸OA%CuOi9¶49¤†žßšøE{\Ze¤#Ç#»ÿÓêFáƺ(âfÛƪP e.j ŸõÑLp‹°Iù(š‡m1H’4àxh‘k†‰·G)¤Úšâï—äO¿Ä(´ÉwËò')%ï~ôœ\§îQå;Z|Sée°Ý¨ F ø’›²o°ûœ =ÃZþpÊa êZ #+iñ À"Ö£p¯Ü —¸B° DÀ;Œyý„›\m‚¸)–dƒþäDB,¿ÿÔë©{—ω&®~ƒÖOÉ>«ç´’SôP;WÏé$§Þý»òãà‘Ÿ÷¯I6_D‡Ý†Þêcjðd“Ö¾úݨ­…óêH¡úòßð*^þË甑SÿÙ8BIMÿâ XICC_PROFILE HLinomntrRGB XYZ Î 1acspMSFTIEC sRGBöÖÓ-HP cprtP3desc„lwtptðbkptrXYZgXYZ,bXYZ@dmndTpdmddĈvuedL†viewÔ$lumiømeas $tech0 rTRC< gTRC< bTRC< textCopyright (c) 1998 Hewlett-Packard CompanydescsRGB IEC61966-2.1sRGB IEC61966-2.1XYZ óQÌXYZ XYZ o¢8õXYZ b™·…ÚXYZ $ „¶ÏdescIEC http://www.iec.chIEC http://www.iec.chdesc.IEC 61966-2.1 Default RGB colour space - sRGB.IEC 61966-2.1 Default RGB colour space - sRGBdesc,Reference Viewing Condition in IEC61966-2.1,Reference Viewing Condition in IEC61966-2.1view¤þ_.ÏíÌ \žXYZ L VPWçmeassig CRT curv #(-27;@EJOTY^chmrw|†‹•šŸ¤©®²·¼ÁÆËÐÕÛàåëðöû %+28>ELRY`gnu|ƒ‹’š¡©±¹ÁÉÑÙáéòú &/8AKT]gqz„Ž˜¢¬¶ÁËÕàëõ !-8COZfr~Š–¢®ºÇÓàìù -;HUcq~Œš¨¶ÄÓáðþ +:IXgw†–¦µÅÕåö'7HYj{Œ¯ÀÑãõ+=Oat†™¬¿Òåø 2FZn‚–ª¾Òçû  % : O d y ¤ º Ï å û  ' = T j ˜ ® Å Ü ó " 9 Q i € ˜ ° È á ù  * C \ u Ž § À Ù ó & @ Z t Ž © Ã Þ ø.Id›¶Òî %A^z–³Ïì &Ca~›¹×õ1OmŒªÉè&Ed„£Ãã#Ccƒ¤Åå'Ij‹­Îð4Vx›½à&Il²ÖúAe‰®Ò÷@eŠ¯Õú Ek‘·Ý*QwžÅì;cŠ²Ú*R{£ÌõGp™Ãì@j”¾é>i”¿ê  A l ˜ Ä ð!!H!u!¡!Î!û"'"U"‚"¯"Ý# #8#f#”#Â#ð$$M$|$«$Ú% %8%h%—%Ç%÷&'&W&‡&·&è''I'z'«'Ü( (?(q(¢(Ô))8)k))Ð**5*h*›*Ï++6+i++Ñ,,9,n,¢,×- -A-v-«-á..L.‚.·.î/$/Z/‘/Ç/þ050l0¤0Û11J1‚1º1ò2*2c2›2Ô3 3F33¸3ñ4+4e4ž4Ø55M5‡5Â5ý676r6®6é7$7`7œ7×88P8Œ8È99B99¼9ù:6:t:²:ï;-;k;ª;è<' >`> >à?!?a?¢?â@#@d@¦@çA)AjA¬AîB0BrBµB÷C:C}CÀDDGDŠDÎEEUEšEÞF"FgF«FðG5G{GÀHHKH‘H×IIcI©IðJ7J}JÄK KSKšKâL*LrLºMMJM“MÜN%NnN·OOIO“OÝP'PqP»QQPQ›QæR1R|RÇSS_SªSöTBTTÛU(UuUÂVV\V©V÷WDW’WàX/X}XËYYiY¸ZZVZ¦Zõ[E[•[å\5\†\Ö]']x]É^^l^½__a_³``W`ª`üaOa¢aõbIbœbðcCc—cëd@d”dée=e’eçf=f’fèg=g“géh?h–hìiCišiñjHjŸj÷kOk§kÿlWl¯mm`m¹nnknÄooxoÑp+p†pàq:q•qðrKr¦ss]s¸ttptÌu(u…uáv>v›vøwVw³xxnxÌy*y‰yçzFz¥{{c{Â|!||á}A}¡~~b~Â#„å€G€¨ kÍ‚0‚’‚ôƒWƒº„„€„ã…G…«††r†×‡;‡ŸˆˆiˆÎ‰3‰™‰þŠdŠÊ‹0‹–‹üŒcŒÊ1˜ÿŽfŽÎ6žnÖ‘?‘¨’’z’ã“M“¶” ”Š”ô•_•É–4–Ÿ— —u—à˜L˜¸™$™™üšhšÕ›B›¯œœ‰œ÷dÒž@ž®ŸŸ‹Ÿú i Ø¡G¡¶¢&¢–££v£æ¤V¤Ç¥8¥©¦¦‹¦ý§n§à¨R¨Ä©7©©ªª««u«é¬\¬Ð­D­¸®-®¡¯¯‹°°u°ê±`±Ö²K²Â³8³®´%´œµµŠ¶¶y¶ð·h·à¸Y¸Ñ¹J¹Âº;ºµ».»§¼!¼›½½¾ ¾„¾ÿ¿z¿õÀpÀìÁgÁãÂ_ÂÛÃXÃÔÄQÄÎÅKÅÈÆFÆÃÇAÇ¿È=ȼÉ:ɹÊ8Ê·Ë6˶Ì5̵Í5͵Î6ζÏ7ϸÐ9кÑ<ѾÒ?ÒÁÓDÓÆÔIÔËÕNÕÑÖUÖØ×\×àØdØèÙlÙñÚvÚûÛ€ÜÜŠÝÝ–ÞÞ¢ß)߯à6à½áDáÌâSâÛãcãëäsäüå„æ æ–çç©è2è¼éFéÐê[êåëpëûì†ííœî(î´ï@ïÌðXðåñrñÿòŒóó§ô4ôÂõPõÞömöû÷Šøø¨ù8ùÇúWúçûwüü˜ý)ýºþKþÜÿmÿÿÿîAdobed€ÿÛ„              ÿÀá,"ÿÝÿÄ¢  s!1AQa"q2‘¡±B#ÁRÑá3bð$r‚ñ%C4S’¢²csÂ5D'“£³6TdtÃÒâ&ƒ „”EF¤´VÓU(òãóÄÔäôeu…•¥µÅÕåõfv†–¦¶ÆÖæö7GWgw‡—§·Ç×ç÷8HXhxˆ˜¨¸ÈØèø)9IYiy‰™©¹ÉÙéù*:JZjzŠšªºÊÚêúm!1AQa"q‘2¡±ðÁÑá#BRbrñ3$4C‚’S%¢c²ÂsÒ5âDƒT“ &6E'dtU7ò£³Ã()Óã󄔤´ÄÔäôeu…•¥µÅÕåõFVfv†–¦¶ÆÖæöGWgw‡—§·Ç×ç÷8HXhxˆ˜¨¸ÈØèø9IYiy‰™©¹ÉÙéù*:JZjzŠšªºÊÚêúÿÚ ?è|r©ˆÊ›Ó,eÓLU¡Ž¾Ã0tÜ|ñCc2€ÅqUHÒ«ôãŠbðGT?c^}¤Ày§£B{¯qŠ æý¢2œ}ŸýY©†‘jñ™ŠŽ Tü°BÚƒÕÀÄljB;!ýc†ñÉŠbIZ¶qÿ5qU´Üæ|rĈ?kGDÄd‹d‘ÀðåQ÷`”¼”&Œ~Gø`p£Äýõ¼^œN<+išÜ×í'ÜqQ*ôùár\Fغȧ¿á O0z¼AYI¢£¦9Kµ·Ëá‚–ÔïQb-ÓÕAøâü×Çj4ô¢ßýÚ¿Ç~ï¥q¥µÞ¢æõÆò¡Ëõ1¥°ÿÿÐè«–s ­se-ååeâ­Œ³û?1˜ qgýa… ”bȸÕ²ŒUh•Œüñfq•d?vß1ú°I6È»1Écë¶$S )ÔP}Ø‹lARe=±2£ºŒW|I“c¶H$!'tüq„EàF.๋â2vÅr±úPšÓa—ûÆùã.azxb²¾xP kLV^e·{WiøŒ^✇ù÷Â:©è ‘´†•§}‡†5àRÔ“r?î4ø¬`™“ã?<#’¡›¸‘]ê zôùåÜW¥F>àûtþÜäPz-·pŽI'¡ƒØãX†rw¡>¥¹Í|197‘Šøáø£«A]¾Ê“J×éľ®ÎÄŽ¦¦˜alÒ#½Mq >JhõâGù'ëk})JÞ9#R„0¡'ç_ኪÌÍÄZW§lT1€‹ÆŠ§ˆå¿ÓŽŒ"ÇFÇÒ¿¬bªª1ëõÅS /°ÿ1‚ûŒcÑþcHþš"´¦ßNCªz*ø…æö²ÿ¨V)œÓ)^ØÙÿF—ýSú°”0J•Øõ¹€Q»Ÿ bÞ¢1¯F÷Ä ú„tɱ_ëSeZeÃ#´Ñ‚v¯LIUœñASà1Xãxî")RNÀâ©Øî(ø¬~¼(ýã|ð:÷üV?^ •~3óÆö>ôõø!Šþ±•p>‘ýqA%°ß!úGõÀhŠ¡È§"xŠ€cà¶*òXnþ4=6÷Ä™u!â®n­Çû±ÓI!–Sé¸joAášKhÁjPšWrp”+<žËüqƒðI“X‡À1O lcáüO5Óÿ½ßë7êÁb½ÿì¿PÁ÷/{TÍýró`KÿÓë§Óüs!ÜÓâ?¯56;wËŽ”5þo㔞mƒ“ª,úüJî>c¹Ñ‚ Fã¨8„Íɪ⇠XÉNÜ|MòÅBW¨¨®6T$¨$÷ÅVM¨;þ¼JªÀ8«¿Jþ8™ ®+Œªÿ!©R>ž¸Â»©ûñ½‚ÖåY[„J@ÛzƒþË…#Pãuj >Á?´¸õ•ÄeBµ;Ržø‘~_º*@`(6Þ•§ëËä•ÝxÄ¡FÜjÈË£È4ÈY+×"¦ n0]ŒI;3FòšT"S}ÉÀ^¨¯ ´øWjþ:Úú[%*!^OFf$ÔŽ«Ó$yZÝ|#s£J¿Rj?âX¹0V¦Öb{ ü6ÞkÍk,f%–„‚pLšÌ±¹‹ÒRÒµ=²= +Ý~®zZOþì°=Ì–È(ÖÒ#°% :}'ý7/ûåàŽ%wuõ†‚iT(z a›è½ÝPÑÝ€à:Ñ)JøTà°•éˆXÃm<Ç#ªµ(«ÔôëÓ}ðlcŠ€hXxdYÈoÊ›†…ŸnŸ:K—ŽØ-<Èߧ‡¾ ѹé_l7°aÕPSÓ%¶Øš L=ª¸#‘âÌ)Ôu;b¢&Òž=°)bµZ²/cóË®¦°­òQñ}¦.‹ëC*£+ÂÿhŠìßÍÇ®ø‡:ÆYÂ1âdèI®ÿ‘íN¿vb>χ\°S^è¡)eä¤ñ;0 ²cð` IAFèÄã$DÀuß/ðúu,ª“·Þ˜E#tRÈ´0µ;:Ó¥~TÊçn â@#mòì(F#â­Ë`(I>Œu¸>¦þŸZ½?É컢ÐCÇœAkRÚŸaS\ÏÁËHÈ@Q½ìlדFd…£@8ƼxÔ}=N[^  áHÛƒ#Ð÷;×Í4{‘Š!ôÖµ §Š·-ÅwðÅ Wà,àíG$Š­Q…^ÀÄÆY¨ÝTìµÇí )Q¯NÕ5»á÷!N8½;¶’ÄÆyý¢v l¿¸F£ *TŠíLSyV!¨Sá׿ÏöN*§‹;£Ué¦?ëÉ-—­GŽøÚŽ•Ë%Ißjæà½x·Ï·ßð§øŸÿÖêÆ´;þi¹~½{má,wé÷n9:¾ôß·Ë)<Ã`äWëï‰ÜÀÒ•Ç0¥I©ëAS‰Là2Ç°nõè*1(µ¾žÀµ+×® òΤ«-‚+M½rýQÀ§JŒ 䛂ÕÈÞê7V€ò$î  l0@Æ[E3*Õ 8ŠP\eäÆÕÖ"§› º—VD¸F[° ù0t1Âã÷’¨ î•žéñ›© ñDÅ£þ!¾žY¦"6$9äi°¦æ§«6ÄÝlÊ vèÔõÒ§¢’+úñ&T2zJà±ÜSpr/öëOP6ÝÔ þ' ­ïô´Xê%FMÄ‚5&¿ëU¿Vä)6{ÓKˆ¤…}CºÔ㿱ÂM`«Ì¨(ûÎþ'M­’ÅbqéþÉ( Sü¬f¶šs%Ér¥Š…¿*S±ºA²¶Ö##,h¥‰ìOáƒn´ë˜;ÆxS‘aÚ½¾:Æà[z’Z´Üx. ウԥš3¨´`E@ߦL›HÝ#ŽPÆ¥kC¿\^FA#w®i^?ª8ôEJÞrßîÊ–9}FÜu¨À9|W«EÒ•¯C×c•Hb 4Ä`9 O•E¯üj0Eµ»Ì[Ñ@ ö,¡ùá ±Ò4ç1Jµ7&»ád—™–ÄìMëƒn`™!a0ôÕˆ^DƒïØû` „yèÛuoÉitw07$fN$•=E}Æ e¸›Ó…—*iJvúp±¡Id¤dsm…:Wé–“¥gzÆñ0  >Œj·HçIÁx—”dî¥v® R&?m»õÿ¢ÒŽU·™‰îˆX}ø„†døŒ2¯O¶”ï9!·4Vû"YàŽ†Oˆý–oõT`2$@$u†µgpê+€æ¼…&ib¤§ýØÆ€W¯e71›–䜇=ú-w§†E&·‹t`õW­[piØPÿ6%ñNc‚.f‹YiíÑT`+Éb–åRÝH‰M¯|mê}eÊ °… £Îì²»ª‚©²ZVEmØòèX¢fv#áR¡$þ8bÒÎQƒ© Äî+OÖp-”²GêîhG_l—V=ˆ[Å"¹O‚´eWJJ ³BŸ…:ãVò´õ ;J6§Ñ‹ ꯕêà}à ÂÞ¥Ã6ëð‚ÀkµpDJ”«PŒÓNÙ—Ðs)^#ˆ]œŠ‚sŠ²C2´A·JnA¨ß¶7ÍG0—¤æ0cPjK¨«Ô߶]a§?]«ü¼7ÿ‰qÀìüNWªzäz2ëÉÿ×ê•$·Lµ'㡧OÕ‰£|$¥ ‘PkŽø©·OÕ•y?I¥O¶1ú‹$­Ð׈ù`Î5êIú}½±’ Xˆ ¿†–«^ÿ䃱§ËV§0\‹ ˆ†öòQjÔ~8”²=Ä4¬Lö˜VŸ,¥ü²À¦6m+á(„ÔÈp¯Jþ$϶hc.¹T½ø…)¶Ê8ÙZ J‹Ç„rs¿ãLÃÔQýËþA¨þ8ü±í‡‰‡21jA&)L0N '>  ÀÒ½wj툉$^ŽGÓŠ‹©†üëãP<^KÃ扆3*…ƒš’H4Ú½úeI³(ö'úÛUÛÀqýY_XRÜŠ€@¡ñú0ñ#…{¬Ii9b9qnî<ÿÆ^ÛÅ$Þ¢Êe Ôb@è6ÿšq)åå ‚Tå í¿±Ã{sEnªQRê¿lPV‡®Ýk‹BB³–^^Á¸ÿ·Ä»S‰ýyG“¾ßkº­äˆbøce!«1#õb˜¨6­{×voH¡ø–› #)Vû†Jšm>³Ê¼(†ZR½ëƒ¤¾¹¶™ÊKë£(f,:|û`8¹$•R‡ T¡¬”ü2Dòc\Ðé}3ÞrïÄ’>ŒmªI´f%Ûp® Ð÷êv®61$ŸT¯ê^‚2hÏÊŸ¯i¥c©Ü‚IÓ¡cÙ‚ŠàK‡¸¼5šGO³Ä½vqÒjžÄJ£ÜÔÿ A¯gÚ§ú«ŽèÙ´°“’· ¬4¥w&Ñ‘gw’S Ì 7 ÀIÕª~g¸ª± ©¯ð®ÝWÔPFñ¥Ë¹pVœA¾$€ »6ªêžgö»R¸ ¼¾Ðùcå+ËJüð¡u)Išv ðÅâ–I­ÚY $¸¥vÛ TŠìAÃkd-gUžG ®H ÒycB~ìR9 IŽüB€+óš« eZP‚ä1`¥`–ŸdÐ}8O"Ì Ä±‡+ ØCá‹R?³E§Ñ\áÅA÷ï•Â:Sùà螯ÿÐ鞣§]éZbÈMZž|AXWÔ"¤TóÅššx  tgJ”¯RWolk… CE¯ž^ýÉ?çí‰Ì´ˆíá’*ƒuâå| 2†bwÌ2 œ¿d|²ñ«öF; J[Æö9yX³š™UË qWq9t9\‰ïš§o5FVlUd´ôŸäqõÄåþíþGâk°Û%ü?uurÃ0èHùeð9\iÔ oÖ“Æ¿019gaÙFÞ§ÁþÞ%qǧ†ÍjÏ!Z‚~±$w šWÜœtc*²~y66ß#ûUFj§s÷ãòˆñÅ\8ö¦l®+ᛀìN*¸nF+pA‘ÈéÈÓO5ø¶¨ëóÅïMne(6æôùr8:§¢”#•Ä+âê>󎸑‡nMOø#‰Ä̳ÄÔèàýƹrÉÉêzšŸ¼“‡¯Á BŽã ìn'‚ÝDME©øp 0ñÃ-“ÃrNÍ^×3LìªÇ—íq÷7>´ h†¢¬«Äž¸Rä1Å_û–÷#øä$jdŠßk– Àl¡—¶ûåz­ÓÒ5ÃÓàŽ¿ÿÑé6`n{.Ôž*Œ¯Ä:b? §ŽäxW-Z¤ ¤t¶V®g?²)‰I!`Ao£(ïˆ8 ÔdˆM¸õ9YU®ù}ò¶M øF<øÔé÷þ¼v%-ò'¨ÆíŽÌp*Ó˜e2¨qVÀ®<'‰ÄóTŽøª¨A—Æ?`sóÇöÇeY7/FJÓìœxa¶øɘ_ýSPW%Ó⎫³¢£å•CØàKx…ÀI¦-ñ{Bàž4#悱>ÇÑŒŒ564ǯ÷FT_g&ź¿€9¹x‚1ÙE€ïŠ´O|ºŒiqá_ž&M}¾Xª"?ïæ?^]ÃrXu-Oø#yAqÓ A{ãC7í+·±BOö8õÝRèæã,mMƒƒ.mT8"´¯ îTþØñÄdÓÝYš2îV ýÛ¯jeq7u†ŸÄ0‚mFûáÝ­¬²ÚEé€Ýv~¾]sxnb*c^\ƒ,€ÃÄÜbÐ1XÓ±¦25Dn Z&kŽ‘±øh+Üøcg ±|B„·CòÆÁu*†e‘–¤ô'Ç5ÕÔ³*‰\¿µzàâè‘6Ú}‘òÇWÛ¤qöï§'чWÿÒ芩îr•&=±ô9A()•Ó&‹ãëŠzg+ÇuS7|y¾4¡Û‘1,i:}'õãÇLbTWnç.£"BBñ˜ãAÇ`KG6c˜b­åeåb­æùf±U’ŸÝ?ú§¬E1³vÿêœp0ôø¯UÜÎ_¨)¾0ŒÔÛª§%ñÄnâsb3é’‰ÝÁÀJw¦0l2Ú™…;œ›ÕožQ4튴¦1€8-4¶ ô4Æ•cï˜ãp¡½ÆnDn 2¹ß1sàKt7ê9=sr$nr¨§±,pŽ£b~œQk;á¬G÷h=°½må&¢‡ª°P< )-ÁħÒq^*z†!ŸL{âÕ#Š’­!Š(•ã*òøM¾coö8‡;ÎUô÷ÿ}ÑzR½<3)‘w†PþÉÜ}Ç/×?WÔ>§ŽÔýxj]˳ÿÓé+¾<‰¨§|Tƒ&©—L½³b«JWƱN¹©Š¡ã]Þ¿ÌrÌ`õÅ#ûRò¿€Ç•ªÆGC”C£îÁ%|1¥|F›(rsŠ”Æü2&Éâk*¹d7ÏÓ®Ù!6¼ÃÙ|°%l¿Ý¿ú§;|±9à‘ÇŽÙ.Ÿulæí˜åöÈ¥n#7\[›®HsAä¥L¢;+&Å­ÆX÷åñËâ<0Ò-ÂØÃ7¢§Äe…à)Ðá¤ZÁËôO†)Vùãƒ{aB˜@;cÕqU¡ï÷â¡è>ì*¤ª(+CòLjGË-ã+ôõaBØî“nØö6ͤkòÅ+„*¤DjiVj=©¦+O• :V˜îY¹Ÿ6¯ÿÔé#‰×A’ðN^2¹a±Uõ¦]q>Yu­'Û“æ?PÇ×SûÉ?Øþ¬}p*ìÛnl*Ý1”vÇfÛRâq¥qc•L ‡1Ž´Êàÿߋ•Æ‘€€SeâˆÛv8ðwrÝ¿Èþ¬Üj0ì·»«—]±„Ð橦ã#ÂYXn¸Œ»œR£}ÎÔ–S.™aN8.XÖ¶˜à2øã©…V—Lpสиð˜à£- í˜à1ØPå-ØåÊÇÑ’¿ÊVn˜É¿¹–*­ b”Sˆ&Ê1ÕÅW”±œ sr#+‘Å_ÿÕèÝòÆxã6A“쌼ñ¶lUöVaž5ÍŠ¾Æ_ïä¿Çã\ØUö^lñ¦l û/6xÓ6}—˜ç3`WÙXÜñ¾lUö$¿Ý¿ú§õfd|³Çy±WØg(çs`KëöÆ/\òl=Py>¿Íž@Í’Cëü±ž?ÍŠ¾Âáž;Í„!ö6AI$B ”8†‚Á@ÝÀçBàÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿØÿÛÅ    #%$""!&+7/&)4)!"0A149;>>>%.DIC;  ;("(;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;("(;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;ÿÄ¢ }!1AQa"q2‘¡#B±ÁRÑð$3br‚ %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖ×ØÙÚáâãäåæçèéêñòóôõö÷øùú w!1AQaq"2B‘¡±Á #3RðbrÑ $4á%ñ&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ƒ„…†‡ˆ‰Š’“”•–—˜™š¢£¤¥¦§¨©ª²³´µ¶·¸¹ºÂÃÄÅÆÇÈÉÊÒÓÔÕÖ×ØÙÚâãäåæçèéêòóôõö÷øùúÿÀx !ÿÚ ?ÇJ¾+°ãšQ@=…8P0éJ9¤)qÁ ÎiO^:{Ò Jb”Žù¦Ðt¤?…4õ¤=)ˆP8§Ï4½é@ã4 P=èq@éÍ 59>Ô §‚:І@ ÐbŒâšEŽi¦!Áxí´†(»y BàѶ€¤c´dþTO4 CjE  —‘K@ßjL`!…{šM¦“n( ^)vÒ@ÅÇj]´À]´m °£&«1Éɤ1†šE7<ÔŠhÂH.) Ðâ“oP¤+ØÐ"P¹Å8'<ÒL¦.Ú6s@‡m£mzö¨>´®21Ö˜E4Ò©Áë@‰ã5a(¸ÉÐV‹…„ÛÍ!Z.m¤ÛNáb`œsNÛQq‹¶—mÛK¶‹€lÍBñQp+S÷°NË×­@$BHÎò1Å4î1#³¹(ÄÅBçšµi£;çíÍÏå’1ÜÛ¨ÁúÖŽVDÚì±wcaªÌ$LuD“èyEas1ýÌi±ž4Ub j@9÷çžqLkòò¯˜T© ³$JLQËØ|ÝË3j6ƒåJ äPq逛-ݳ#€â¼õéR£!¹"˜ӿ>´G|‰&ÙU[=X1M MíäÓ' ] Ød.+JÖ×I•w$Êp§;Ü|ö¨æ’¢Ê“GmUêœg¨lþ`b«3JÌ¡¤VÈùúé[Eßr±›ïÍ/˜y欆U‰ÕQ–ÇAÍ[†Êö]ª¶í‡èYvÌÔè–£Zì9ô»ôVo³9 @ùpÄddtíïU‚ §°4Öâ‡ç¯5*LvòwëM¡&>ÌLi»ž$ÔlpJôõ‚ã‘öç(®?ÚÏüTÑÜlG ƒ´F¼ƒê^Ôšc&pÍ/c{`Pj ãu˜Æ>”ÊθR{UiÍ&ŠLgšÃŒ‘ž X†é“8IõQÅ$†Ùf+¬ ÔŽù'ŸÖ¥3DÊ E³ïI?ŸV&ä‘:Ã*̯!X?^qÿê¦K°‚w)q×aãùZz††âßE¸Ks‘¨ ‘€:œsœŒ|¹êyˆêïä£Êr¬ñ‚¤–=ú~ÇÖ°Q¾æØ«mªj—òniRsà1 Žq‘‚?úü{SõIôô„ÆÛŒÿ(C´© Œa‡wìOLäô·;D›Ý]·´·½WhJB‚ªÅ¾nG|õçÛÖ£¸I-a~"@錫uíŽx'®:ûQ~Œ-Õ %¸¶Ä÷!€,"B[qõ Û§Qše‹o›cîHwå°@úçÓvÉA8aŽzƒÓÚšº³+ÚÊÑš +H2cr`öú‚zš«,’,§yFF[š´ˆm‘ %”·$ž­ZС븯>î2GQŒPÁw!,ÌÙ<½NY|—Á8ÏcþýTén-EüÒÌ@v/Žœ:{ÿCÅj‹ø®—ý$ˆÙP*¬ŠHn=qÆ~N~¼â²’ìhŸs.9ä·™6ˬìî^:cÒ¤»¼{› æRƒ¯hê@wþt잢ÕKÙ-“FfšIp §9ÇO§ãŠ,e˜ÈÑÁvÞVˆ‘x r3Jž…l6âèJî“:¹Œõ=9éÍOok£J$½•JÅ™vƒì<ÒÕ-Fõ*Íc;˜¤YHÁe!±êøÖtд¨ß|“–Ë )§pµŒ×‰•È=ëZzf™4’rAèÃ9ü(rI]‚‹nÇ@º< 7f-·oßéÆ?•:j<>PgUõ üýk/hÍ=š9|€Î†3½Wo=òzÿ:š3e¹ƒ2äÈS~Öô#ß“šéé¡ÏêVNõp7l÷=ÿÈüjâÙ+¬o$Þ¸ÈÏ‘Áÿ=ènÃJå97+à®Üttÿ9© åb6fãëÓúÑp&HÜ&ܹ Œžý©Ññ( ósÔ~¸  $‰ ’C…Ðd¨bxõñ§Áûøåà€ac Ó¿¶}jZ°¶Ö»‚É€ ÷ö­K{¢˜È¥TÚ¨à~µš.1ý•æJÒHÅ™º“R&™l($zŒÿ:ÍÔ} P]@ÙÛ‚–ÔTMgI'>Ýk76h¢„œn‡Õb;bœªíüi^ûŽÖ'—ªþF”¸.Ñb¿µ¹µèÿíÒPhotoshop 3.08BIMí ResolutionHH8BIM FX Global Lighting Angle8BIMFX Global Altitude8BIMó Print Flags 8BIM Copyright Flag8BIM'Japanese Print Flags 8BIMõColor Halftone SettingsH/fflff/ff¡™š2Z5-8BIMøColor Transfer Settingspÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿè8BIMGuides@@8BIM URL overrides8BIMSlicesoX ni00404 X8BIMICC Untagged Flag8BIMLayer ID Generator Base8BIM New Windows Thumbnail 0pTPn@ ÿØÿàJFIFHHÿîAdobed€ÿÛ„            ÿÀTp"ÿÝÿÄ?   3!1AQa"q2‘¡±B#$RÁb34r‚ÑC%’Sðáñcs5¢²ƒ&D“TdE£t6ÒUâeò³„ÃÓuãóF'”¤…´•ÄÔäô¥µÅÕåõVfv†–¦¶ÆÖæö7GWgw‡—§·Ç×ç÷5!1AQaq"2‘¡±B#ÁRÑð3$bár‚’CScs4ñ%¢²ƒ&5ÂÒD“T£dEU6teâò³„ÃÓuãóF”¤…´•ÄÔäô¥µÅÕåõVfv†–¦¶ÆÖæö'7GWgw‡—§·ÇÿÚ ?ªÐ¦’“X¦V‹žÀ ÃìILF‰Ô¶(Øñ^œ»ÃûÐR‰kDZðgðUÜâL“$òŽBÒÙR> 0ÈSÚŠ‘: 6ù 9n¢X’ËK (ÿÐ ­HV­6•1J»ÆÐáj ”…JØ¥8©.5SFßctÕÇïT$’yî¶ìÇ*¤!Æž9É‚‰c t(.Ñ%p·(r¶ÖÈY´YªÔÇp0¸TkQ5«‚¹ Iq«…¤kP5«¦¥RKqòœýDVЋìnîÞÍ•¢a}fè—°œ«-ÂxµÔ›š|vYC¿êëUéú¿õ~ÚI·®W¶;ÓËÑkm wõ-þihßÑíéä` K+pÈ}®“ccùïç/®ïä?õKè)Œá õyìÖ–äßoé&§\ÌêmÅÛëpÝô?E{ÿó=DJnŽÁ´ÜǸÁ Á#÷š×ms¿²¨7 ØÃûIý>¾¡dÙú;ŸM2ͯ†±û>ºmÿ‹¯ÒYÝO¤Fk~Ó•KÆH;}7°µ»}íennö1ïŸÐúžžôՑ棽_“½n^/Ûk[a1¶ ?8Gùi9•]»Òw¨Z7°:KšÆïo»ó¨âõ.‹Ó)hn`Û-­ÉlýÜÛÚÛ®Úïç}»èA¹ßWò³ª¾î¦u}¾ý€{šÐ÷:¶2ßÍk1}dó½~ÄðäPedôÙs>ÐÍÍú@‡'úÍY×ÛŽÂ?MYØp‚>+c¨õ ú­MÅĶ«w{-}×ÝßF·dcTïRÏÞo©ìýλ£u,JhaÖÀâÙÝ?™¾­Í§Óþߪ驣ؕpöÔwk·ÕðÇÄ¹itë›{¶Vö¹ÀnÚ&õ7.jÑè—2ú¶¿‘é†Gòª«ÙÿEK×ßé» í/®Cv½Õhwk¿GǽOªxGgÐ{1Ûs™ºL˜w¼ô\}=ìoùè”c[“o¥Sip±í,iíé7asTäýc-c† »˜sƒÚXãùÏö½÷&=k3%·ä2Ü{äK‹ÝaÛËÿž}¬ÿÁFê@ŸЀõ³rÜâY!¿Ià£]±¿óýEJãèÿHcèœÙ±¥£Ûü½YîúL÷*ÿÙ[^=L°5°l¼>Vû?¯ê=d·ëOP Øë$,‚@oõíõÿÑF1Êw û}-ÿÒãñ™mo¡]–?†Š&“³rºz_Y†ÚÜ€ÛG´†™pÕ÷»üÕ½wUίÚ~ÏÓ©x²£Û¦ÝmŒõç{Á×+ÿ¨U—×òó fdca9¾£öm- }6Ôé©õº=¿ŸùÿàÔþá:è<Ë_€ 5ú8Ã.ÀßMÎ%­Ð1Üì»è©Q’+xs@û¾Óû¿IŠæg[Äu¦œjs«i÷彡¤ûce?£kÚÖ»ôŸúJÑ­ hŲëzgc\ÿE EÔÖëÌÿèoý#3¡¬jÑÃgCnU{ìle¯s~‘ôÜð?®æcÔ•m`ÔÍ­$‚AIGé ßØV±(}¸vÔëXëXm¸RÇ[c¬°ƒ¿–‡7ÕÛú‡z_ØUÛn.è}M~E„ºÖ´ƒîÚÊÞÛžÿäµ..›«‡è‘¶â¿ùÏ]Ï‚A/tú[7{¿®uMx;ð9;¦ýR-mAâËY^)sOÐÚÖ¾=¾³Yc¨®¦nölßüâ|j+õËh ;}ZÚlý/vײ–{3}‰X¢åØÇ4ÈGpb;`³Ô.qtÉtë÷®¯'ÊEÕÛŒÊ šÃk y2k~Î}Mî­îÿG[?áVF_EÎ¥„Š=VÙüÜ“ê7û-Ù¹îýÖú©¤Ä®¸s?àÓ“sìÛ?ê·5iÎ ü§dedíCƾÚßI¯\íÔÙSˆsK\; 6.AÚX=ÎwæI@Þ .7Z;N¸]푸îw¨Ö´nŽw×¹FçRÏLíph;ÃÃœ>“ÀözMþOéa`[–È{ÀÓmŒkÇï5ÕZ[fí£Ùµ&œœSúJ,¥¤í›Zu1ôwgö ‹ XèöÿÓâìµí³ç^k{}qKKZÉ%­eï~öiüßóŒÿJ©»2÷PÌf¼ŠXw–p7Ÿo¨í]ºÍbú6±Î¡¶E‚£·pÚëk¶û¹©ë¡ù×mèíWÆŸ¢îû¶ÿ[ôŠÆƒ£f›qñØÛ쥶8meÒw8íöÔüßÒýгÙüâYsªå>Ü«ÂAôªqc@Öo «ïEÀØØÜë\3ìkK¶6½»^Ë-TØ×Zw1NãJnuóF½4wpºðuõœëﺶ€,"ÀcÚòð}ö{6ú^ýêÞvEXW37Ã#ÀXú_¶æ7_V¯¦ÛnÆõ6ÿ1s=f.nÌSAn÷Kw¼Æ–~ú-O¯²Ê›kkIp:ðàýß·óÐá³cìM»Y½S§çcc¸a5Ù@ŸQÞÊÛ©o¦Û mþŽÝÎüíþÅ=´bÖ×1¬4dnÃfEŒphѶֿÑ{·{Ùìý'ý¸²ñè·"ûqÖÚkÜ+}la׊ÿMæ»ÔZX?VsZ¯ÚÇ8p@wàäÉÇBkÂÒŽÂÙ>žEbêÙf¹-š›uŒ¸jcÔ:Ôæ{Ó±ÿõµ&ô>§‘Šë*δÌ|_ÿÔá2¿›gÙãÓû=~¬ý/RI·w»é9é×b}«Ð?gŸO_SlÌéüößÒWbÆINÀíßf»Ö™õ zqô£ßêï÷lU´×wÒnî#ó¡g$QvÝöoM¾¦ýÐ#÷¶N±»þ‚'Oý™ö†ý¯Õôtçù½óþg»gúý€’l¶;ÿ‚˜î6ú¾«ƒöOI¿eÙéþnÈú ëc´ù¯IP;–Øèû“î˜òåFï³k³tÇøN'þ·î^<’i\R»í’}±ÏoSÖŸú*«¿çDþ‹ölvþ~é/7Iý_C?ó»¿ìÿü@ÿÎïû¡ÿOø¯?I;üT}¯ÿÙ8BIM!Version compatibility infoUAdobe PhotoshopAdobe Photoshop 6.08BIM JPEG QualityÿîAdobedÿÛ„         ÿÀX ÿÝdÿÄ¢  s!1AQa"q2‘¡±B#ÁRÑá3bð$r‚ñ%C4S’¢²csÂ5D'“£³6TdtÃÒâ&ƒ „”EF¤´VÓU(òãóÄÔäôeu…•¥µÅÕåõfv†–¦¶ÆÖæö7GWgw‡—§·Ç×ç÷8HXhxˆ˜¨¸ÈØèø)9IYiy‰™©¹ÉÙéù*:JZjzŠšªºÊÚêúm!1AQa"q‘2¡±ðÁÑá#BRbrñ3$4C‚’S%¢c²ÂsÒ5âDƒT“ &6E'dtU7ò£³Ã()Óã󄔤´ÄÔäôeu…•¥µÅÕåõFVfv†–¦¶ÆÖæöGWgw‡—§·Ç×ç÷8HXhxˆ˜¨¸ÈØèø9IYiy‰™©¹ÉÙéù*:JZjzŠšªºÊÚêúÿÚ ?$]—a¶Ã7ãyðKmCÛüü0„•Ë_¿jû`4˜È¶¡iR7ÛlS`ôn„Ój±Ç“¹ooö±»d)Àm¶ÔÆ”»‰¸Xð×%ǧã\È®'Û§L q)Øxa#ɪv§\4ƒ&öïM¾œ -Õ{}Ø‘j c¶]JŸs." [u?³ 8•Ãq¶F™qŽ­u­øxSÄàµö¦Kv\@ÿkßšdÝ*?ðÒñlà)ÐwØb€[¦Äƒ¿|@GaGJý)µMéì0Ó v\§µ0GeÇ­i¶Ýp™Q]EîiøãJOsºSõठw´`;m\4Ê×)¸ßøb¶[¨Øm%UBÔí×’ÜlTšwêpVq©¯nÙ$ZÖSáôa I+x…ùá%ˆ°Ø R½ûà¦BN SÜÿ˜Äà@Þ”®ÞiM…¯^ƒ¿Ži@·£Àb'VýñH-’ATø`d|Ýðקùœ4‹ íM†ÿ«=ë»Aw©ë^¸Jb{ÛVž/¹ÀPx“ß @- Îݺ`PZ¡¥;‰É6¸ƒJmáÙ³vˆ×… ríÛ x—möZtÓ1%­¹¯áŒAA;´#~ÝNI!³AZ‘nš­O‹$ÆÍÛ³·lÈI¢° º„¾ãÇÀmcVµ#+‘m6@‡¿Ó„$–¸€>Ž´úØv>8”Å(@¤¦WcAÓ¶$¨òp =+á65M~Õþ˜imÀS¥w뀭÷- V‡jaHZÔê6±î\@£Ã® ]º5ïôTb‘ ÐÛ½2JMrväÖ7ÁLxÉæå’ÕëßHò[N'À +#äæ¦Â? cªÝúžýpÖÊÙ•ˆ¶D¬ ®ý| É ÑË“¶;ž˜ÐbfÕ7¯Aã톑¹äæ¡é¶ Í­¨|r%”M†©]ëÉÄFú´ÀtÛxà¶D[Du€H¨ tþÌxSų@wüG†,z-ük$HŠ‚NÔ;䩉“‚’)N˜¤†©á¹8îï@|0•šÚ š Ôä¡õ¿'ÿÐ&ü«Ûå›øò‚ÇVÍhFÄ ÁÆ™[8|»ä­¬…㩧Q€² Ž•ï^¸­´IÛ·§ e+\i·¶D’¸rmðÕ Ôºw8-C”Tõ¦$(.§~çgkiÔoóɲWo¾ÝqM6zâ€Ø4m¼h+‰H•4@‡ˈ7J“Cô`ZwÐtï„&»—@j;푵ál é‰(š; ö®"H<Û=OùN4ùxáI-ï†/½ÀnHÛÄdn™[ Ó¯|(6Ýi½:ãJ-p¦ÛP÷Æ’#aQMºûà´áZÖŸNSÈ;øà´p‡›á÷`$6hnQíÓ%L›úN)¯ Jx{öÈ€Ìöl7Å^Æ”Â@Fíó¨$=ò<,¶ïp=ÎEÄ-k÷`¶T÷ 5®nØ&„ƒ;œ×À{ûbŠ¢æé¶!‘ÙÅA"½ð¢Áp¨4¯l+»lvÅ®RjÔà¦Á»e?YÄ"[-¹ xo„°‰=Φ¿µÜãl¶.v©{S Ñéíà1=[®Ä×ïÄ–Pä´ÈÜmÛeï[Rz¾PwäØ]¶Å…S`7û}ñ%˜‹¾·SƒšìŽ»Œ4Çrßô÷íˆ @h/W§†’)¶éãúüqxmkxì=ð£“b½N ´¶£ïÀP Ö­¿\C9qSÐÿ ð†'vú-zTõÆÔT¨ù÷ùà°R-®•ëïL7HàXÝÇJ÷ò(üâ·/ÐÔöòHÙSôeÈ^Ajæ™Ê4„+MÈÞ»Œ7I-µ>ÿìÀPš€ñü~ŒB°´M¾ü*6Üj§|ïM¡Þ½ú€†÷8±®Ûx“(ÚÏžãÄङ_5¤Ôí¸î;øa݉%³ÜÓj×Z;î>UÂTõ Wµwë\(vÄ‘ÓÀáZkaZïí#gx*|1cn=H®ç¦ ¦ÀC]6é톘“KvÞ€¼p†&þ¥:Òž8J›h€Fù|–¬5Æ‚›ÓñðÅ"Àw.•èW|Ú=v©8Qa­©^ã-µJ‚+òý}p¢í  AÉ11qV§mëáL”¨)‹ÿÑ$5¯_žt Õ<ð¢9·Ö‡ÀtÅH®J” ¡© þŽ[¹w'ð´:Õ¯ÝáãÖ‡s^¾ ì¸výxy l¾„š–FÙðÚóçâ#a²¢(ií^ñŒ‰p°ëý0”»tÇšl8PŸë‰E[gj÷¦©Ô$ï±1+¸ïìz×,ãæêû¬š ;}ç¶ø’={WÃH¿á#nÝpP@ :šžž&mÿ¯†û”ûPƒ¾(Ûªà7¯ã…h9TÐÐöÚ½pµƒk‡ÅÚ€W®D†ØƒN;fø9©ojÔá´ téSÓïßbjÛÔÛ`)lìë\Fìd)¯fßßå‰ ¾öéZíàp_zd7Ù«Rz†FÙVË=©¿ðɹ‰4ð#| …¶)÷uı­Û%yR´#jbãP1 A uØwü0­·Z½;bƒ³`ToײmŽÞ=ñ%5m/*’ )Ðœ<Ãh¶XliQÓ"##Í­©QJøaE[{JдÁI²ßÅÐŒ6D¸ Ö{à滆˜ìÉ RZùý4ÀTSM"'_§ ­DÈÄš}žÃ¶´êì)ˆRSk->Åã\ݬ*z l„¦zQá­ÐׂÍg+nÆDíR†¹(“Õ„òC³_!]ímÓǨÉnÃgTR½6ü1™Øä~Ž¸Ý \v óÇ“"Öã¯O P 6Wnà×$ÛP)¸© §g1  DJñ|I4éì1ªI.ûü°Yè×AZî;b¡¢M>¦¸v[=0ø‚îAïïˆNÍ5Ô}=ðÕ­÷*Å!G§ˆ‘MbŠpÚìBßÒõ'¾E³’O4‹#l(+×,<˜ƒjN¿«"æ¡5#·l"Há®NÚ…O~Ÿ¯2®ö«C^ t¯Ý æ®ÕŽ§ &í I;í·\I@ ¹ÈÒš¶” “O‡¦6µ|šé·âpÚíÕÀïN´Ú¸@(¢6Û¦I×zøtì0-¶HÜ-Iî2;§‹m–Ón´9;k¶‡.½)…Cˆÿ:äwgMTq¯L!‰¾{÷ðÆÚqcG4}þØɬ 1 cn*Jí¹8ÚÑ­œRh1Ùéo·~„œ’M]»×®(ºu{/Ñ€„ƒÜ°‘O‹Þ¹,PL·ÿÒ$]«Þƒ:È<à•y¯“Ó~ÕÆÙïmÒ›×qÛš_A·¾)§o ¶âqä›îqë·S‚ÓVâ)Mª1gÃN Ž½ÁÂÀ†ÊïïÒ˜Xn €ëQú±,öltëòÈ‘ ðÛqÄ ©JwÀ Èê*Aڽ𔎮 '~ø©¶'–ç b2CC®Ý¿VH ãðÀ›¥Õ ñ=¼2!%hÛoÚ?¬dŠ¡»b”µðÈÊÛý®›øä¸XñwµCÊŸzb¼×u¨24“]Ü+C¾(ݽ+øaSk©MÇß‘g»Tû;ä¹0ظ¸öÛîÀJ§Pô]½ÆD6Ô=·ÀBc"ᱯöclhÓ{í]ÀØüñ¤‚¸)n›¸òM¬`%»o¥IæH÷8 @6¢w5îqd঄ö’6o¡¡é •ÀŠT ¼q 2Ë…G^øynâ ; öÉ1«ä¼ÔmÜ÷®—u©±¤q8’ GÏïÆ™qw7ÈöïÕŽØ«Š÷8­6ª h*p†6SÔ£µp1 Ò¦ƒ©=p€‚)vÞ;SéÅ\y  3iëòë„ 8kSý”ÀBYQË¡4É|V¯Ú Vž8Ts]@Ç®FÙš¥Ÿ« b$ o‹qЈÝÁn@)^ƒ i*f„}=0r@6V•4ùt¦S!kG^]|ÃÍÙßõäFÉZ»Ó Q&Èì*Õüp‚BÐÛW¶ mS^´é„¢ éM÷©ÈÚÕ-ß·á†ÂZÛ~ {âP*ÝÑŽÔØÒxûšQßzwñÂB,:‚¥»S® R7KEI5ß K«±ßæ0ä±÷´k½vBÉÆ;õ–°ûñ´p‚îä(§LYnæ Øœ.Á£öwÅ7²Æ й!ls-zmý˜ÚAkáïÜ1„‚›ÿÓ&iÛ:òyØŸ%JŠï±ÿogÆÑâ@߾؆$…Û×ÀíôáLCJö0$Šl\4 Žj«Nÿ:`f*d‚wÜöÂáÈO¿‘tº›ïŠ•AÓn‡Ç'¦Íjwûð(6Ñ^ÿÏ);6S§Ý€•áêßCR6†2îãàv¦ÇŠq]é÷œ(4ãŠIn´Þ¸Õ¤Ú‘ßS|w¯ $’\£¥N-šÔøöí€3¥è=i„±¾míôt à´¹6=«Ó¨þÜ%® kü03¥Çðœ!¬‹-ñß½:dL™€í…wí4×KwSCßÆŸ<"‚7p¯ׂÔÌ´U$ìkí+Bô?@É’ŽÜßÂZ„}ß׎{·^$Ó¡Æ­j¹;ö¶;žØ±pöÁLíÕÜþÞ4¶;—u&›xâ‹Ð#möël¶-qÐûíLmªšôߧш·\܃¿_Çĸq¨¶ôÆØ ˜ŠíÔu§Ž '—'n (2èÛ'Qºþ‚«LÑF7?ò÷5ÀQv…{Sq×°ÁÉ—E€¨RGjäh–\ƒ”žUöéí’këkć ?vfKSÛrc溬~Ã{"GG#®Þ4Â$U•ßà ÝJõüzS,e‚ƒéÚ¿Ó$w`6î^{¸äC#ÍhkצÛPǧ~¸’zxØ)­=©‚û“FÖ:†$šôÝ'Ÿ53EüpÙ,*º;¯ÑÛ¦,‰¶Øî;÷¦³‰®ÝðØ^ZW·_ŸMðŠc]Îøx‚7=1¶G“€£WõýØ|š¾6…´'ìÒž9*UÊWjwéï‘"—ŠÕ„V³(‘Bhi^«’,E9…ßÉš¾Da'b·¦Õ®<ÖéiS·ê°1!uA¿€Æ’luZÀíøÒ¸E-[‰ê{ ,NîjÐõÛ¶D€˜Ë½¢[jmüq ’IåMã°éýq^V ‡o×’!m°>Ÿl {Û¡¥|p§rÞÇåA¶ÐDW¯Ž$¨ ›TŠ{`ÊTTøÒ›ï]òL^¤^ãèÀÎ&—*ÔìqäÆí} =°ØNíuÁhć¦<ÓE°k×s€‚Ë›Dƒé¦X˜ÓtØË£¶Ìá(®÷W¿A…—È;öh~œPi£ÛÛ§\E±!x5½}°Î.©¦ý0Óïh)­;‘øbBE¶hFÿ~øÚ ËoVí¾FžýÈ8 CJx|ñHÙ°I>ßÓÌI¶Ç¾Øû’{D“±öÂ%½Õô_sDÕ«þ8i¿pzü±¶@7°#õŸÕ•!r3WÓ‰@æªÔÚ”4ÿ?×€rƒ¹m¿¿$¼— ¥:ôú1(¡±'Ãq^Ÿ,SM©>=q ¸’6ûð†Geɱ'ñÈɈ»Ù{ò­FÔßl6³}Á× Z§ù[x{á Qd;b|=ðòYäѧZüÎ,\ÃÜä-ä´ýžù;cÂârM;ãeh[Cǯ‡†øÚûšS½OüPêo·^ý†ø –©Jth{à,…Òä ÎÇzbŠV6æ‚€œE§gcíý0€‹hoNØAݪ€)ÛÃúâC(Ðq4¯êñÇtKÉ£Pa„R(†÷?? ‰¦@–©Û¿†Iª÷ûÇ\(«h©ÛŽÃÇ᥻Ðo¸Æ’O›PþÃy7Ô14íí„1µƒ­zœKÄó·+C¿|Y]óhÓåì´Ñ§^; Ñ#à 7.‚=°†©á¾øT—Vƒ—*»bE¦ö[JÐõÜàÙpáVï¶%;»ˆ¡ñ=ýñµ›un»í^ù( ÂAÿÕ*}=Æoâ΀ðÖͯCN™"sdw{œ 'fèÀþxXŸ6èoãˆIVÆÇa)%PtÛ ƒE>/‡oll Ó”‘Ð}:¨‘è½Ö”ï¹ÀžM¹íÐÿ ­§s¶,©®¤×$ĕ£®õÒ®níòï‘e{.Sq]¿HH-0§N´ßè‘MíL+ÅNéú°nÈÉ܇@_˜ÃL8­Ûì}ú}cIâ§OO»S+µÝ6§C¶½Ü‡-‡Ë 8Å·ð÷ëøcº 7 †Ýôé&éÅO*ýã ÎÛ]ô퀲7; TÓn¹B@¶Õjh >xV©¾=±QäÓ:¨,Ûwùà@Ü¡'¹f4/†7k-”EI ë‚–ûšÚ¢¤öÀJûÚ%ªhAñðÄ]Ëa·}°ÒÎ߯Lm–Áqzƒ¶ÃR[ZacJŠô¥^ø)‘]Ì°éÓèÅCaêh»aLÏETPøÚG›Oü£Dœwÿ>ø¬7_µ)‡…UÍz¸å¶ävë OˆšÒ{ãÂŽ"TÍ)@i‚’G›|hxó8h£`ÑÚ»oáÛ’Âwéµ6É —›FÇîÀ›!®» »Ó¾U·B6ú`æ¼Ó~£Ã+ V×qRONÛc(–Q§U$j *“¶ïíJãH·1­HöÆ‘eÝûóé’¶†„ý4ùöÄ¢"÷lúaÊ;ÙXÀV„a¦66‰¯µ:øÒD‹ 5øk׿]ðÒñ­ñ Ô|ð'~T|öÙ±ád&à*>ê`ªbdZ+½:× ï[M½¼q¤ñ©Cá톘µÓ£’\WǦVÎ á\+H¯j“Š›€`;bÈ6j0± P6;ž¸ h;(Þ›â£Üà„îç©V¾n*FØÒ•¾5Û®,\*}Ï|IPG%¥-AMðÀú‚˜¿ÿÖ- $Pó¦oãÉкÇ~§å“¶®ìl)^§lʺ»çß_zêA]ÿ¨ÀM'£kðzãkÉW­éá‘MlིV®+¿SßH¼°šoáÛ$Y[¹­;à%‹Tç\!Œƒ€qÛ·Ž$”ˆ×5Äu$ý…¡ÞШ­>œ+nãJm׿lVÂúSǯûy› qÜvÄIxm£¶ã·l) …o , Ž¿çLÏ…±C±ï÷ÐøâPÁÁ)·€ÜøŒ¤n¸€;vú1 h •+†ÖŠíÀ u®6¼-q ïNŸ,mH.é_±8ó@¡Í°{xcKn ØžÝLIZµÄ›dYA® ŽõQ JjzxclWߘÛ0ˆ§ô‡Wã‹|œEˆíL ®mÔce$Ûä1b]Nÿ|™Dq4= à  ‡Qïß&Ûˆ¦Y¶î¡ë\6ÄD(É2ÆiÕ» IGYYÚ§¯ …³­”ùZý8Òî^´¡åÖ˜ \ô­FàžØ …‚¤vÛ ‰=¼vïˆ4´:®-ZW¾6T€Øë_¿$ ½A§AÛ®$ªð)P^¤vĤ.Þ£Ìè…Ñ€+˯ŽH±çÕzÖµoïor@mˆÀV1l ük†Ë#\qß ÄÄ®û=hiÐà(Øs^k¸ p²%kО”}õÆ6¤‡(¯ÑôbIGi…jAÇŠ–­®; S­}°¨Ý¢¡Ûƒ‰&+k¾ÂƒÛ¾Nšìt]³úºd)#›@V»ü°¨;´:Ó°ð†Ü#¼ 6MFÃÜb¶© )ô bJ…9>Ñ!z}çƒä³ŽÄÖ•ßÛZ.;qß¹ÀËÞÕjM+ôœxŠM8¨Ûn½úcÄX­<¨iÓ­r\A<'›¨+A÷ødI+ù¶iµ7#aNŸŽ6ÈD4*NÀvùãÄË€-ÜõØo·á……-§†ÛwÃe؃]ºäxRNÔÕûx‘†Ø˜™wØoßeNàÕŽÝiß|"Øšïo¦Ê6#¯LÞŸrÅÜ÷=Æ$¦16æRE éß,ë½Ê6¢Ž½~Œ&ØX\=!¹©>î»4^N‚€wì¶z-*Ol›j€ømÓ (µ¤Ÿ‘Ð`Ð|Ö€ÔÜ×Û¶YŽø‚ÿÿ×-»oøæþ#`óäWVëß Cd|"’l¸š˜ëíˆÌ ¥ÔLJAîoq×îÀKjÀÖ¾ìh®Ë¾gܶ§Z~8§sÍ¡^ÿ/lSÉÄm·LC2á¿aQôâY ÛÖž©4Ý7©;b +­4&‡ÓH÷¶jGAŠbi°µO†4’[¦Ýi·|¶î45a×jâE5B)CJ÷÷ð€WN•#­{ïŠy6ûŠW¾ P[ õïí4Dë÷bmŽÍSm·ùaI õ¯·\PCtß¿Ll¢ƒ[ ‡Ž,7µN`\:W¨Å1ßwUvß~¿<ÊÃkò©í\HH6Øþ³Žè VøÒÛ¾"?Ž ‚y¶Vàa;;‰"ƒüöÅ_'­;øSîÆÓÑp*|k oé‰!ª§¾Øìƒn]úøuÃ$xÛäRv䇸»à¼rk¾Gšš˜³|Dšž¸îÈ7ÛçÓ#KäV†íO‘öÂ×*t?*wÂ"êÔ×ðĨn âq¤k–+‘!“Fƒ» P@n´4Óï ‡%êÔ ñÆÖÂõqã¿lSr¡í°År±àa! €« Ó¦ô÷ÀAQ ½ø“±®ûœdi hEz᥮¥QKlÄz. ^»aG>m4 u#©ööÂ-HÛoO»Æ$8 ׶6’}v¦ÝþX²Úš4ñÛÑ@4j ?ŽGs]@¸® ¶TPwñ5Ò }é’¦ µJž(·^˜S깫“ôab»’€Bl0%c) ÔüG EX õ"K1¤Ó¡§¾K›YÙß zo^¸7e±ZÑnò[0ö¯‰î<E‘µ‡r?ez:|;±¶÷øw÷Èp²âòZßjíÐöï…•¶ûôÂÅo¶ï…w;Çc_|HQ.Ž<·¯á€RMõl…¯Ë¿lX5¼E+ZøýøwA ;¥ |NÆ]ëjØV½)„È´AFǦ»¦È":œ ¸‡rÒ+îqSß*S–Ç ìщ¯Aá‚‚›èíºþ¯iy­?ç¾Oõ‘ ÿÿÐ.*‘óðÍôy:)óÙ±ZžÃ%A…¸ ý» S\@¦Ýqµ—“`Tx(»‰l(Ù¯¤®ßÿLPE¸uõï‹ áJï·| ƒg04¥k\@¤Ûc}üFÞØ°»vý@¥1 ˆïoR{ AI°*µñ¥pÝÛ|† 2âvÜø “WS¶ç¿¶EC^ƒïÆ“"Ø^´Ø\ To÷䑸]E;ƒµV)w˯|@R[R+¿NØeø·=Ï\$»i·ÃüpÚWwëá€$ØhWø×ÈÅk¿ùœlHدM©·Ï2èí‡Ë®‚áßµÁI¯a€ ׿~ãÃO›–¤|‚¶*;oŠx]·ÑˆAµw۰ĤãÓ¶6XØp5?F>ô‹oç×ÀâûÚjcPã‰% Žä×uÙ>Ï|Ú"7CšîFõÁÉ%²¶Ã¦G‰<>KI  vëŠÐh­MÏl ˆ[J {áDZð'¯A…h÷7]éøàdß!^ÛuÅ÷8Mûᦓ€|;7·ËÃå’%ƒu#cßm°„¯v“¶%E/RGÈœ™Q^´+^Çøãe®€è¨¤q¦Ûûa)è+Ôü°ÚUQQ¶Ç¶ Ó± Œc%xŽÕ'ß'k¹§Ë$ “EHå\žÊ£¿†6µkJ°¡ùáµ£€ të‚Â]AN½ÿŽ6à>/lmMmÑG]Èè1 ifÔé¿€ìqG“€ß» íq÷¯o–68 ÖFøYnÚ×îñÀi Õz‘×ÕIïÛ µ"§!¿á‚Ùð÷¬èhpµiý0Î!¢*+Ò½=ñµp¯}…6?ÃZ   éÜá»-+M‰­ÌáR[¥:‹¨ ckJø W¾6Ú¡®Ý0Òñ÷6V»ô=@ïZ¢­EïµW\K!»hÅYªzm¾16²ªÀ6¡ÉnÇ„ï^ÃAu)P:øtÅm®ÛâT[¸µb:œS¿{D|[œ(Zw?ÄâÄÈõw@þð&¼–Ó×ã…kuÁ7^Ôê2P–èœ,?ÿÑ(lO¾oÄv„Ìw.î;» S[§µqMù»†à~8’´ãômLm}ˀ؞ÕÁk_Sz¿ NíÒ•'è÷ÀŠ!±Cкüñ1,Dƒ`ìMiZÓ -ÀWn¦½pRE›¥=é„,¶n¤Ž€W,d)°j~ï”ݸtü™éá¿Ž6›îp]úÔvÄ•¶èÔ§c€¸õÛïÆÐý°„ кã²bm°O vÆÕ¦Woã€16Ý(~_ŽJ’Ù_»®FÙðµ½)ØtZÁw½7ñ‚]ÇnØ-ip®ý\bEÄ ?ÓŽÈæÐ O–SW~Í8ûÔdH[ Ô˜@A-õëÓ©ïÓÑw€'¯lmD\ö“†­x·u ü6ƒ²îôï×ÛÃ-PmØœŽn¡}üN7i–¼ˆŠYÈ ñIJã@ÏpÒFðþ¹RšußYhRµë‰Hq$Ðf"(2ZÊGÏõckÀߧsüqOp'­wì;"ÏWr¨­>œK+hÖ½°"›Ap2 ä)Ný¶I‡§«a–„ø‡ðÁ»+ U±öE~ÖR¼¦ÝJ}øXì¾:Ð’}鉤5õ4ðéˆPW…¦àüðñ) ¾€½N¢ðZÖëÁÒ›vÅ‚º¦€l|1l/WbiÜwĨ6×ÅSM¼1 %z3ªò½0”Ei¡5î1¦'ó©Å7ëøáÜFß>Ÿ×†Fëvö;y²VŠòùG%ü«°Û ŒŠÎ;²V¦;´´§öàFÎÛ`w>ÞØ+¹Šlõ§Ý…¨Ÿ&êñ=‡†V¦wšƒÓÛm¨û‘„µÚÒo6¥ÞêT6;oí€Û(×&¸ÓjnwÃÄÄ‚´ WðñÄîaÔ=GN aSäà¤ìÞ$äJ@¶¶©ÛåL4¤Ñ§2ÔÒ@Álºw-aZCÝNÂÍ´A¯¹í…m¢MEθ)"ÝPGZÿ·ñµÇ~”ÉZîP×Ç"TlÑRO§(²\¦¾8­-ã÷a´q©Üí㑶f! ¦ß!†ØÓ\H5Š×s` ÐîN1 “*‰ÿÒ;/Jøæú< îö]Ú½²L[è:øãEÓAw'µ7»¯ßéÈ–`¶A ?¯îÀ•í•*§ø`âE²ŸÓ¾MM…ÞŸ~R"Ý;è6ú1Òm±Ón½ñ®ö>çPnzS·ã„!p4¡Ä¦Ü7Ø ‡|ˆ›ΠüŽEèGS\ÈÅ xøacɱ‚™‡T$»S 0%ßÇIrþX HÛ×~¾QN§Ñ†ÑÉÀTrmaôõÄ”sl Ž›l“ýñ 2oÏ}ò[1Ýr‚M~“€•%½éħ#An¶!®&£Ãö,Èu:Óüûä˜òlu߯†D…°á]ü{Ÿ79g}ŠïúŽ€ÒGÓì2Iâ®Mƒ½+ìIÆÔÛTv<]㿆6šX~ÛÛÛ Û(µÌtî~ym†š-½;øžÙ&½›SãÒ»nÈoÍÕ¯zü°%½§Ó’ JðWñëÒàOÝÔa ÂWƒMþœJL@]^ǯlE­¯Wõá6ˆÉP|ýÉ $,/­Ûn±!rá’ Ø ö®@lßFÄïÓÛ$’ÝGp+Ó2°¾¬vNØ×z-ßµ_¿¶Zj×~¿Ã¤[ Û¶$$;sòîq Û¨£Ø~8Û.´î~[Ó¹Ú‘_င‚×Âzu놑a¢7¡êzüñRá^ÛÓe[Uø¼é‡¢78` ¥ºÒ7ªÒë…ƒ€ñú02Ú;ìz÷Ä,µAÔtñÂÄ€íþTèiŽËE­Ël7„á ;u'ïo‰ xÞ l!iᬇu½1¦@¬¡NÞÞ+EVî¦ût;Ôâ–ˆëáÓïß$´Û x|ðw½ÿÇ;‰ç·Òqµæ×Â|k× ?-ÇÓŠE´íï†Ð)±NOðÈÑ 4NýxVÖŸžþj`R[ý¡·Ñ“Çõ3‡ÿÓ»¨?voãÉÐÈÙ-ñŠÓÇ|“]O€§£©×¿Ž)+Žíþ}0(‹tÛ·\Yn«̪Aø®@ÁDŠ™S]¶ iØíï†Ñäà7§Z×H ‚íZý dvuMO¾6Çc͵]ùy¤l»‰>N M·¸ÙŠ‚Vzï„1!ă\h¦ûÛ”7ü:œiFÝ@ ñí‘.?‘@+‚µzn{àÙ4Z}ºâs&ÅIéó”&‡JR˜i‰"Û¥Ó “=› ¤ûxcl[Zý8 8ž®5톗‰£Z}±p)±ÑÄWéÜÓÅ°õÀË“{S߶;¨lƒAì0ZK”Ó¿|(§Pý=0Zdh(Ó’bR¸˜D¼‰«xdPRÙ$.Ƨ܃ÓJ™®)àvùõÁi!ª“µ0¤ötéÓA˜j»üT§q‘MÚÖaSO•Ä‚cÑ ÄSî¦4ž"°Ÿ‡£bwêÙöÿm}Í(=þì¤ÕÕ?vøE"D¶ =:ø`ªd%nZV¢§Û®øm4»r7;tk֡눤W®ãõcl­R*)_ 6¤*(}ðqèz|° …ûWÜ!—½A§oã’°Ä÷¯Z‘°v¦A°VDf/θ-@%®,;oÞ™;`ÝNÞ=ò ¤†ö§JáMw¶†EzõÆ×`êlí×Ûl …ðîJ­ˆ4×Ñ¿|iå½@öé€ì—5;SbpXZÛŸã’[©­:ÔäxY ˜ØõÀ)M††ãƽü2Eˆ6½§@:o\HHY±=kã€;õ\((>ïž,}Ë…hi÷ •÷£uêÛo·¾GÜÈ_Uê*6ßn¸Úû•ï×%Íj•Wo‘ê0Ú ª(#`zâ7HµËJbKº¢Òz÷ÀYª%zÒ½+L)ânµjýØix­Ã—*o]¾’cÂå=«¾$lš¥Ô© ûð&SÛïÁLL«£XW­ñÉ#vÊ’<|kˆ*M´A§‰ýX”Üm¿¶RCˆ:õÓb|š ¯ÅJø i@:ž»í …Iâ ~œmÔn#·¾@ì×]‰ùÓ$ÕžmÀñïˆ *qIé\Ä´î~„§~®!(FߎE.Û¨ç…x‚Ð7Þ¤Œ>ä nॺ} bM ‚yª *Ä%|pZ€Ñ®Ãâ=lw)µŒÄÐô}œiwZËRvñÃtƒ䵇ŽQ°æá^ý»ž î=w®)æÑ b hVÍPwíã„°°Ð]€?/¿T9…>Ó¬†ëYA;oóÅ•­â‚›÷8m]ê<lŠÜµä(7©9n!ê yeQ/ÿÕM@*è?¦ocÑÑN.QýrmtSnÛdYYjƒ—O¿®L0"×+¹Û"K1][ þ¼¤Ó€íÜöÅA\6þ˜ÓT4øw'%³ #“`~WiœEó\ mCÓ¦FÒZ‡å߶H¢KÀÜŸÙïPî"ƒ·|#f[8}þPâíJa Kk°® Û‚oOÇJ/«töí‚ÙÐlÀ‚{âBœ>à:}øO$^íñ'côœmÛ)Ôn!x›$WsSÖ˜ð È4q׶$¦ ®ã÷u'­5Ä’)½? !Nü›"ŸO| !¾=M¾ìm è?ÏǾh1põúqMŽßg®æ‚{—0ø¿Ž 12pçŠ-Ê:§¶àI¯\ ®Ôn.!R*ǦøSËš[#“×!tšOjqBÐ -ø@¯ŽÀbBmÄГû'¾¶¿á’ªQ+äÕ@>$dJBÒµ®4™uAëÐ÷ÀW˜ZÛ ¶ð¤ãÓ}¿K+kMÏLÈ4Aê1R¯Þ7TQp&€±D;b+]»âv@ ·µý:Œ>æù~Z-òéOéŠïTä»vÀ´¨¥A&´öÄ‚˜:¯Ô ž)µÊI¡9$ÉYXÐ í†ÔWÐ6Á³#²¢WceV>\»Tt¯†%l®ø{m¿Ó„Z ÔS ïýqP¡^½N4Ç—EßGL2¿&ÇSÒ½°­µÄmS¿p1E:†¾Ýh0¤nO·‡±ÁA6m½»l 銒ê íã©ÝÔRkM‡|m6¶žÛ÷®¤S^ǧ¾J˜óæà»O™È™2Ä Ó©a„ZŸ{DmÛßïÂŪµi^Þ8dì⻟ã¹'nmmO~Ç I¶øÐPõðȨ xÿ6ÀvÉ[;×  !{`´“\ÖZ–©8mN!B)ÐäA,ˆZÚm°ö©ÃLAèêSäk‹.šâ>^&Ñ@zÏRp ô`-5¯: i¹–´Ø|!Ýbu Züp¨ ÐV§¶Þþ8k©qÜ1Ýy–õ4‹óq3;|ñÛ¹ ù¹H/PÔñ>Ý2XǨ5å’ÿÿÖj¡Íèä Ží‘N»V˜XñW5Åw¨ÿ´Ý6ëµqP]AZžýûᢲ§-:xí¶4Y9Ķ:`FÍûWÆ›ð4' D[ƒá$µIÅlÕ=ñ [ޔDž—xn£úऒÛüüq@òu >#[•+› [°ÀÂY$ŒòÛŸ !U3^¿¯f`V€hE:xbQm1=0ì´œ,ZèAÁeZ PÓžVàË7®Øh±ÙgZ×îÀˉiÞ§¯Ë ¤€y8Ö„}8ók¨¡éŠH!£·õÇšik•ñÂÞ\I©§Jdi–ÔÕ?®%ù.S]‰ùW¦‹{ýVïeËRwïúð±#uÈÄS¡¦v;•Æž8Û^¼¶¯¿@z“ôwÃa;ª­zžo½geEcZw¼=ðZî¨6éß¡ðÉR ¢¹ù{ü±)WòÚ½¼qSî\*MA¯jà Íx¥;PàgN©è>œ 0#ͱOë\(Ù°¿Ž)¡¦þçuq?IñÁÉSÍÌ£é=0 )“` ßÀiÓÇ  u*(<:Ð B%Š×ß%"Û N»œL’#Mømצ(³n*zïOƘ/¹°ŽöøÿŸðŨÏ*Æ•êÇ ñÀJ W,ŽòMGjû὘›S ò?‰À92 µÞƒ®%VšíwZh>šÐ<ƒG‰ëÓ¾,HšÒ7ë·l6‘áZï° wä´¯L  Á 4¯}ò$²ˆhžý}ð„›qÚ¾8-xVµAùm„5–©Ëúâh3y4zÓ¡8…•´I=è0Zw­Úb@§ˆØáG'Tûx`t™¸’?VÖµØãi ¯QN»×|‚/šô>ïßå…E/B>Ÿ‰@$uTV÷éÐœ@ $ª!í÷œ$ õPéã‚ÒBº¦ÿø[}°™Àë_£ÃÚðÒ _ó#ß%ly¯ê P{à ®Uùû× ¢›nHñÆÓÂØÕð‚‚„–@°Øøà)ù¶@w¦Èì×ß·‡|“MðV»x n”n´¡5Ûo×ð¸6>9¨î;P}ß<$¨‰%®;â %pZtûX L]Æ„u?-†! ú}°” ÝƇmÎÎ;4W¯‡ãˆA ÿ‰NÍ: )¦Šò(­0Ý"¯“\H©ÆÂK¿dôŒ$²€ŠýðÛßn|4¶ß@:x R´©ðÛÃÃlAcD5MˆâJC|GQ°8 eÃkJŠw$a¶46ºn64Ä”ìZã¾û{ãlHjŠ(EI÷ÃJ|š*ÕöÄR —ØWoqD\ª*(>Œ³½a¯0ôÿÿÐxCEöú)›Èrtè6"ŸæpÚ(øW¥~~õÆÒa|›O]ûT …á-ññÜa´Ð­Ë‚þ8X&€GpvȤÏJ`I=Î⢃¥0Ú*×pïMúãeâ<)Mˆ÷šrŠ•uhÛ¦Kv;t\ôCvé½iˆ*@p§N˜¤Ž§zoŠ7q^‚›S¾G½ºPí÷á Ca G¿L‰,¢A§ë8‚´\¾Ã­1(‰wµ·C®äl×ãSÚ˜ (ÁzšR¦µÂYê ëô ´ ÒÇaýN(ºhM«·A„’‘Nâ|:âŠu<~ìÈÔ-ãQNþ9&ÚßµÇïÀžpÜï^Æqµá+JöëŠïÉÀõéòÆØÖîZ““Å´‚äÿÿÑYFÀmý™» è¤wÝu<~Î,}Í…?=°¨p¶ÃÇÝ°(:n:׃ÞߦøÙNÎú|J]ǧñíy¸+Ò u8m;ºžµØÇ º”97MÓ‚šÐl0”‹èêm¸©ëˆEw»ãµ0•á¦ûŽ£'ˆ·BM0rAÝÔé_ó§Ž6ßoqŠ ¸Ž”ùâÊ›§Çn¦ÆŸç\RJSñÃlHn”¥6Û‚àNØ6H%µ SÛÇ „Yu(‡c‚ÑN¿Äa]› Þ¿†FÙP.©¸íí„–r¦éÔõ°3ªj›TýõE†éÒ»ÔuÅ\åU‡zàµÝ*¸™ä~G§LYn‡l!­#¨§Ë|,­cACßÚj¹­"÷ïLIEw4,¨°Óu÷ïï’HhŽôØõߤ}5èpZJÒ^¿,RÑÛ¯oö±JÞ„bÀìÕýºTck¹Z;ŽÃÇ d DPýûW"[¯ß†Ô XM?Ϧ<Ø“ä×B~x”ŠwjvÀÈ–ˆ|{xà´SºðÚx[4û»âŠ¥Ã`)¾Ûa´k×p|p.áQH;tˆÄ¼KÐÓz÷ùáFÊÝ{P`Hù*+zôû±H ŠE{xä©ATF§ùœQÍUh §Òp]¨°ªBü uÜœRy.¯¶G¹}7?:ûaQ³tß~Ø…–ëÀ¥{ž*$د‡\“`tÿ1ï‹ š5ùb¶[âIö¯o»ñµMúmŠvqRM:ƒÐbiˆæÕ kJÐýÔ8m2£tÈÚFíq§¹íí†Öˆ[B*£„¸ƒ¶ÕðÆÂxK¨6Ò—5š·Å€¸v‘¨zx\7iC:Súû`MZ“¯M·¯\X”È©ÅIµ­Cß­I®!d²‚ü߯§…Çb)¿zàZhŽ¤œ$(ói¨Aß|¤ Y¸¯LI^¸ÔTv®Q¦½?T‚µ~|mZ;Ü1æ S¯Ìí\3µ´Ó½7ß¾,vZ[¾jŸÐâ¦Ú_ÃT{œPýØ‚‚"”ìGS…iµEöëóÀR ©B0sIïl(' »xSs‰Pß°©h­öýxÚ,®â*QÅw[ µß§†Y²Ò»Ó%l8]CÜ|ñZjºUªv|01!²)·Sü1¶ˆ?Ù†­ü§SOã%;º›V0lWp6ZGÅ¿lPO{tÛçÛÙö'¶4¶ê Áøa¢Ä–¨zö:S£MíóÃkN¦ÞçµßGÈŒ mÛßr­X×zß-Åõ‘1/ÿÔ0QðøŸÜAÒ,¶žÔï†Ðßßjœ!‰. í_–±äØv»ˆ¨8-i° švwÅ]ÇÀtï¡wò£MéN½°‚ÄÆÛŸw†Ypç_œd¼-*Ò0"ÃA{¿|S»|CÛ¾ݺ‡·ŽØX¸­züñ[o…NÿØ e%Ü;t®ã¤óSŠ7=0ÛÍ@¯ZâÉH®ØJ-M’¦ –’Þ¿1‚IRdé½wß“æ¤Ë¾â½ÁÂje{øöÈR+IXGÝï… ,jSmÏL´wƒ×ðÉ-ÛDŠR´®‚Õ6ù¿ŸöbKÍcF+¶b”š?‡Ç|}é!E–”ÿ:ãH$Ò›MÄá Egžß~Ø¢«›†çmª(G\"–š×¾çûqZÝk@(1dÑÛüúá,Fí¹ ý# ¥³C;û–˜†ˆ¯N§"6Rlì·‰èß8 MM(;“© ›}ø£’Ú`,ã¶åºü^=0U&Å­®õ¯N¾9 Ä€ØØùiÝÊwì6Û%HâÝP Ûøà ‰+Ô’=|B *:oâ)•UƒjÐf"žPš}8X•£aÜN%A êGmMñ¢ËeE5!\@¤X*¨Ûuúpîº*üúxᢨ…Žû‘ï·¾@*¨&§Ûl(%p R‡n¾–6U:ŠŽ½NË⺀ó¦P@lÖµðI)p½ð­»aïÚ˜9 6jT{âÎÚ ;÷`,H[A¸ÃhÝÔؽ{aRLô4ÇeÜ~ü ¬-;ƒAÔm„0÷5@+÷ábißu24[ø>]1ºMZ×ú1"šâHðð8K˸ŠÔo¾ømëH¥_Ó‹\Hëý£Ç$uZTõ; VøГíÓß ¨UzWÇÇ"S]Ρï·Ïe]íq¥véØáES@PØ¡®?³÷Œ,iªSn¸­S|r6Ì9ãÒ¦•ðË1PkÈ=%ÿÖ7UV¿/§6Ñ;I /uÄv§Ìâï]›âÛvöÃlLHl ãC¸ï¨îzÿm;b x _—PpÚ¶Âíá‚×…u4;“¶tC©ôᵫmSüÎD”€Ý:žØ¢TЃ†Ë]Y\Tw=÷ÆÙÐw·aˆIòp=0±÷-Ð`Ý;7ÄvùckÂà vÅw¶ûíÐôÀm (O\“Ͳ* ÀÊíºwîzק`î?AÅH°êTøo„4 †) ¿†€téLB)ªî<1d[ãó#ÓÉÀxW%¦RIõ¤ڙAßlTSuˆ&ûší ³¥1-ÛüÆ ›B²ãç“´2ƒöq%<*F:©Ú£¾´iM×jþ¼i=7Se¨¯†%T0GLm(º’kÔ£ #u6ë¶ ÙlZâ7©ë·Ë²–¿ëÂKC¥=ð€Zãc¿Ó„#e›JuÉ"Ú­O| ¶ª|> ‰d [¹í„\ywï‰,@+h^¤oƒÜÌPæêm\V–ß¿‡†@-pk_ 6±lP×ñÀUÕ ôñÇbš¥ý€8A€^¤’w©#a„¨½IÇ»UMv®(*ÀþÍhGZbÊ­QMi¾Øm€h2;³Ø*¡F]•—a·Î¸ÚHUS·ñÅ‚ªW·L6Æ6¨+Cóí‚™AãøaE/]ûÔ÷Áïbúºá 7lµOöbM-nØJ·ü0q2 6pq ì×ýÙ"TSDé ÜÃs·]ê=±Ù•ù:ƒ¯lÚh´$÷?,'’ˆ4;øäm]B~~Ý2HæÑPià;ãi1uëôW€Õ6ßsá#~mp§8m4Ãc^´ÛçŠNüÚ¦Þýé‰*"Õ1 !A¢?.Ø’Æ 4TxÔô8BO“ŠšŠWõâš.)¿^Ý:ãhªêÕ jON¾8ÒD­®&‚üq¤Zá¾â  âJ"æN€øàœ€h­ëm@µ Ûæ1´Vë‚‚Ôï“ÅõLzKÿ×: Ä+·LÚÇtÒ;®+¿Mûá› A·~Øۥʭ±{ÿ IX·CÜïß#.÷ñÂP-¾µÁj[âܾŸŸ\6¶î5õßèȧfÁ5>ï„€‹-ñƒ÷ IãO—|8ot)5®çÇSe¨5ùûd“ OU&ŒuìŽSJN•ýy&%Iã¨é¾BÙtPt®þù XŸ%6Ž€àeºžÕ é‰Ùˆh­Fçøcl‰h®Ývê1´VóÚ­#zuoN˜-•[E~*ôðÃ㦵é…\Û,8Ð`!+ Iþ„n´ 'äkøa(£J ìFÌnú8©7§O mZ¥vèpAÇc·l ºqZšŽž8B+MÿD”µÄÓ­ŽPK‚rõpq'†Öñ¡ýpÚ4à»o¹ÆÐ(5CJýØÚ|ÚÔ“øcKÄâNÞø)$´WjÖŸÔa4Ñ ã…)M©µ2Ø.ÔFŠõ5bNç *ª•có8,µ@5¥2BE‰ˆîUBkïßÃWŒƒ¿¶ +jêTw$xuÁl¨+%i u¨·ËdvUSU;o©ÝU+°¥kÛ (áW@Nõé‚ÑJˆ½éO§ ¯+ÀÃó퀃AQE?†&Jn„íÖ˜m".ãÐîN6Šl­>Ÿ ‚àµ&•§cפ‡PxWåÚI®üúü°‰1h¯Ñ¿\mŸ ¸xôëôãÄŽ ÿWA ¥=û M­4ÉCóð ‘Nááß® ^€=¾œQMR”?Ž) ðïø`KvþQ+ZE}«’´lßóür$­[D „Z–ˆRO0YI¦¸×a¿êÃÄÄE¢‚§¾M¼Ý°qnžl®6š[ÄÉïñ6»¸Ž´ÜöÁÄ´à O Ï\³õ¹FƒÿÑ‘…4ñðÍŒK¦•Ût'ð ®Ço !ºw§^˜­·Æ»ñµæÝ6¥:ž˜WGÓñÉZ8]N€‚qA-…߸ îàäuÆÔÂì(ø ^ÙSõ l² êPo·Ñ†ØÑp{x`M´>žømC€4$¾X®í÷ùýؔЦ Ca6¡ú0(÷»@ ñúF$¥¾#¾6¦-R PáVéOâ;`(olmxmÁ{ž¸Ú@ã¿Î›{áAòwÔdYßÃjcjÄwëß@.¡#Ðo§^øìÓ-GË Õ©•'¥~X­)´gèìq%%M£ïO|m•"ƒîÃhæ¤ÑíóðÁiä¤èo£G ƒ%EkO ä‰ZSu5ü1UB@þa‘Ý4 “&Ût#|miH¡éØ`´Ð(øm‹Dã¶u+Š-ª£&©¾ÿqÃlHqÛ¸rZ@W|; ¸€)øbÒÖ”¦% ¸ÔŸŠóh’:íŠnšâGÌxckmPŸnØBí¡½ñæƒC“•O^žßFOõ3‰ÿÒ“*(áÌðvtæ<ÛãßïÃe+Šûñ¶\ spøckîl/ŽØ.ãQ¶õøŠš éJb¥ µîp .㱡¨=ð%µJìÌaâZwƒšÝ6 {˜¨6Ønاn® ^¿œY n€ŠÓç”PqQO»¶ ,«gqû¿¦,C@vÜžã @\Þ¸E·^ôéßZ P}õÃh1ãôxciápøö®%–éNƒCe¥k¸Ûøà´¬ua]þxB ôQe |¿V)° ÜØ”©:‚zVžø©:V´ÛãÉmI£ðñ8‚];‘†ÑFÔ¤MúWo|AY]ˆëóýcIJD4­*01*&õ<0¦»”]7#¡±µà¢Ñï‚Ó¸GŽûá&Ô¦€×°íz©ž§ß$Ši€wî=±â@‹¶®Ç²áZj6?F6Š=ê|ªGß„/ DiÓž)Ü4k]†Ø±ß¹ {l·Û0)²Û×òĤNÃcŠTv4®^D'kBz÷Ál€îTSMCã†Ö••—m÷­) €¬„ŸÃD!õ둲“Ëud=vé’¶®|•ãcS^Ýq,ÀVN]N6¦*ËÒžÛåxü *q+ÍYHî:`âHŠ²Óu‡·|mh*]†6´9.{ckAx^æ6´('§NÃRâ^˜¢È[×sQÜøáä’-Ôôß°ÆØÓT©ßc÷ãléÜMwþ¸-4Ó(4Øâ“N*npñ"‚Ò½)Ó¶6Æ­ÜE~žp%¢*~x§gÂJOϾ+"ÙµýXÚ*ÖñßñÃkÍ®&¾-•m³|w=q´¼Nç·†6Š=Î"§Øb–›½za ¢†£üûbI*p^ãaÛ#i«X@å·OÇ%jCºŠu­1µœïãÛÃ'ê e‹ÿÓ–qÃ3ƒª!¾$v8Ú)ÁEw;aµ1wô|°±]ÇÇ ýx"©µ;w¦k$ô\©·¾ÙYDÍÄoCã¸ÓM[a|zÝñ(7¿*ŽµÀ›h®ÞõÃjCe{S¯Ò1Chv®)ÝÀw§¾ØÚ®¡î+]ñSaÊOô8Òñéµp$Ñw»Pô®6šÙÀöºáb ;à)o;íàqµ¥´¡þ8Ú†È5§\m[צ+Â[â*kôø²ŒH Smé\Báà>œ Çzm†ÔÅÔœ Å{õÈ ¦¨Oë†ÑÉu*>ð2Ü;Žç~Ø8–š ·Zƒ×%áZA&”ßñÅiMÐoÓµqµ6¤ÈG_¤áRTÙ®ÛãºØSec߹Ƙ‚T™ ¡?«ÊíEø}8ך’{”¤s_ dA‘¨2»%hš>¿¯_z‘M·ïÔ`g²Œ‰×îÆØ¡"‘Ûä|>xA ‡t#äpñ Æ”™H<¨®ˆÄ¬$u¶Æ™ÚÊï_¢˜·¾Ã¦ݦ­Ž ev¶´èjp£p· W·SRñ[@ⶶ¦”Üþ¬Þ¶Z'¶ÞøÓmw}¿YU¹ií¾¥êëÓ§Ë/ bzn1UUcO—qÓÛ%]Hã¶Sò²šo×Ç ±…t“qøa¥´B57ž5ë‘Ueq…i]ŽÛ”ÆeJѽ:ôÇ…þ8 gÔH©ûŽ ‚ÄØæ‡u4ùì2T5½>XÛ.;§_-}T˜liô ˃e„Ÿ wñÆÂÔº¨Ìá´•­RÞïˆÙ–ånÝÞ4ÀJy4OÞ;b-‰+XŽÝÆøV‰äÓ|"0sI!¢M6;àRvm[¨Þ§¥p¨]^>ü1H\¤lÛ U“}úx`â^ ÝU_é®’J"#P $Ž¸mZ¼oNÔ ‚ˆG&‚§O!Õþܲè®ðêq´d+_c°ÃeQñ©®ã°ÁjB² †ûô®+¡¯]‡zø`(‰TS·…Ó$ªµíïªð>à|q ¹ ¸ÐŠ“Ó ¨²ƒøÔ಼-MÆ>ôC±¥GJãÉA'›Ší×Üãh[ƽ~ü•± Õ©^Ý+ãLYPïuo¿ Eyµ¿nø©-+Ó¿ùÓ Õ6þ˜§wPoÛÇC‚×ü÷Ä–@­ããøá¶4Iwm÷®TÐ&½0¢Ú8Ük½qµh)èE<>XÛZ Ã³!²Ýûíýq mýzøbJÄ4V?|¤4Gc]¾Œœ¨0œOGÿÕ˜Sz}ùšêÔ'ztÚ¸Ú[ ¸ѾUÔìkA·Ï"«€=¶¯gÄС»aj½×R€šÔ`¶{ºŸ@2L-¾#zïúðéM½þüÈòp&´ |±¥°ÓÐãkNãZà´ð»‰öŲ¾éÆÖ±ŽûáC¨6#åLJ® ÜÓKD(ëÔöÁhÙ²xà´­B}²LD‚êiMüND–aéÛøÓNÁ±NãbK€þÞÕĺ›u¦ý±G5N } ƒmáÓõq¥¦ÏQA°ýxwh»[©A°©ìF6 º› ûâ‹qÛ}¿†;²•¯A‘²»w5ã½ ’º•uüpÒ š*<7Ãkb”ˆZW®ÿF ך“.ÛýV”Ù6=ÏZäSaI–£ÈQeïÔb"¢éQCµ0ÚÚ‹*„t±6V&”ÝAß)4T¹öÄ”UÐá<ìƒ}«†ØÐPhè Eiøœ"‚ƒÆ:{Ö½ð’v‡oóðÇ…&j, iÒ¸íÕ$÷,-ôøiM¿¶²²­¶Ø¬E­? ;`dJÒµ@5Ç“Y.e5$ôÂei$l{×’zÁÜö8¦Ü»Ôë•^CQÐSéÅB¨45íပ¯F®ýŽH¢(”mÅ_|ˆ“#C’"6é¾%õhÞƒ Q=7è=ú`,†È”c¶ý 2*HWCQ¶)Ñ]í_y¥†´îL“UЊ~¸ PW§\ŠB¢õ$ôÂAÙPWǶø”W…'ßO6èÔ®6œ©ñÆÓÂî4èpZÑPO€>pÚ ¸ƒµzõ'⣡ÜvLj–TDݱÙ"Ã\OÐØìž"Ù ¤ƒ­6ù{d˜ï{8‚ÿ:â Hh-hNÝp€´÷ n„î>ü69­Þ¾þØNîê=¼p[Öô§ßïˆeË£T>øJÓD´~4A#ø ,nÜ@¸8—†œEq íªíO|”y„Grÿÿ֙ЊwÌ«u@P ñ÷4ü1´p»?Ϩlj /(~/Ã|I)ÙÁEzíúðq/ ÝîdSë—QÛ™OYÇÛ–TÍ4PÂ&gVŒÔÕrÞ¥Fô÷Æ%LjÞêÞæ5šÞE–&ý´5§…rTÅTݦø§eÛWs¶;±y¶ Ò¤m\§fÀ”éÆÊ€ØRAÛzþ=qEÓd ê:b<–ÇV‚îc×e³a|~üy±ä[T^àüÆ Ó²ò›V†ž¤°§sßïÃkÂ× LJñÃlD[#~½1´ˆºŸŽɾ·áˆ’hßéÄÓøÓ~ø²·SãŠÑkŽõîvÛ  EºS¯NÿN Rrƒ­5¹¡îvÃhÙºlOo ­w7ÄÓøa´ÖÎã¿·L6ĨÞ?,²§·O–$•4ÙZRjÄqI=ñÝÙ ©¦ßçÛ%kJOáÓP› þ;ãkÃJl€íJ~¬[‹£J}8CXQu­*+L)¼]ÿAM(?Ó+ :´Wzöè0Ú·iâ Ø÷ÀÉiöðÃlDAj•ïááNÍq­E>œ* @h~ì'• sÙÅFûSÇ,ÈÓ¸ðÈõEìש¹Ûl±¦Š’¿AÆ'pÈEÿ×›Ššö9`ªæâ¾8veEvÃb+‘!A¥ŒXE'Á{ýÚH´“ÌÞn±Ðàâi-óÝÛ‚**Äþ 2p…–¬’§–Íw=Íä3]Jf–bÓr5¨®Û{oÓ3£5íjíÐ@ÁØIÈÕ;Pô¯†FÃ,“’¿”|Ý&«5ÕÊÉsmïDCùs)ëÊ!òjdŽ@ÓàH &Ñ5ˆ’K”꘡ð+QˆøRîBÈ­¾”¡£”Šún81 ®åÔîш)!Ô4ßja`"ÝiOó[EGO»*@hÞ•?G݉b)ÕvüplÃJd(z™À»|Tü1Ù4ê†6šhõ5ëß K…iííŠ-ºoÓøã~l©° Rã±Ûé8 QÞƒ ¨R‘{So PJ› ÜÉÅ l´Ø¿Ž4›Pt5éòÅ):TÜâ{ÔÚ5%H¦øm4;ÎžÛ‡Ë  /z`6 åOlQj•<¾ï§$ ~ -#(’†hÀ=>ŒQHyR¦½úa¶$¡Þ3N•êp´‡xèkãM¿ŽÒûåp˜“lñ††{y—”R¤µßá ÿ¶Úiyn2@ Å­Ö˜-. üöÀµk{׿ŽH.#o O 04R>×ÿБÅç?,ÉL×ñÆÒ ðz†ÀíL¼bœRûÌ¿+ÂÑÒȲµ ¬t µ¡c^£å’¤ÇŒ7{ù‰¢/°åzZµ”ˆ?à…N‚E‰Èyߘ¼ß¬jw\/‚ZXE(ƒâ}·®ecÃdI)J‰®kqq!PrwbK¹w˜›*Ö dÉO„ׂ×lÆ"ù¨ê3,ò¼t$FAèÀdxNŇ㠲k½Pä¹”­ 5|~X »Ô@‡;€wéÐ÷ÈU¶räÈt>yÇJ¶šn¹{gj‡”pE%cSàƒ¿ä‡(ž–'vØêÚÙŽÿ9ù‘f‰ëÜ[jQ¥APfù¼&=ÇË*:>âÚ5I’ÿÎHyín=I-4ó ~®Q¸êyså‘ü¡ïQªï_wÿ9'çY" oe§[ÉÊ¥øÍ-WÂ…—åz«¹8Ñ¿ç$õrµÔôH'ÊÒfˆ“ãÆPãþ´Ò ԃ͚é_ŸHºˆ5øºÒ›¿Ö!i¾áõWïÊe a¸d‰NíüëùkæH„I«iו!dD”3t$ã"·Ñ•šêËbÞ¡äXÓæôj6ŽJºýÿk$$CIÀŵWÓê×6Ï鎳D=Eùü °úW$&Ôq”Gqm1>œªôuÀÞ ­Š¦9ÁøY[o á¤)¼t¶ ¡&£jàZCȇ­ð'Iبê:AÜÈÆ k”©& ‘ÇÄ@Ê)´eƒR¾2iFiÞ`“Nj¥¸)ÒŸÇlŒ±Z¤ËQÕ4VÓë]õ¼Zôcá·‘ŒBSMápüCrý–ýœ¬BQ<¶gqÜî”ëzÖ¯¤Ú[Mq£ÍndzHe ÆëGBGÅûË 5m2Øõ÷›õyØØÂà˜ÚœØñ÷"Ÿ†^1»êt› sR¾µ—UŽkËF++ÂìP®Ãˆø²9%“Ê[ô{=†•§¥ª˜ZÊÝN凌'zn Í\¤mÍŒ]Že¡’%Vê"†%}ØVóWt› “KÖ'ŠÝ•¼Âhún%Aþ©Ìlšp |3HŽoMòÏææ·q¤Lº¢¢ÞFß»»âY)þûùYŸô…Ü¢êñ…dvÚ´Ù@5ø›(•Ë`änÄüÁæSÍŠÏt¦h¿¹µVªÔ·oµ\ÊÀDy¸¹&d|KêM&ÕXãøQNü{團]§ž^Sl‹F!Cs 4ø¼NS”Ûf SÛ{…–ëÕäIZõ>*á\¢›ÁTÔ仼U7†ÞÆŽHÔí!4ë‚ )Kà‹OÓDZÞ¤õBíõ jQçuÜ1¯ìÖŸêå–NÁ¯éÜòDyzßUÖîf×µ)#Œ+—ì¨ê>â¸àDPæ˜#ei~q:¶²t½SF ުŠ¯èÍé«<œGoå¨ø²¹c ]²âÑ ŸZò}Õ•œ·vR‹ècFq … "ªÇ 2w¦X«pñï0y£Ìö×1 ­¥ÒƒF\DñkØóaÅ…?—2±Æ%ª@Ž‰sùï^[A!• ’BÖ5©ë–x#£>ô:ùç_&gŒ–©”újØ}| ÄÊЗró3 ­ÈUzÐÆŠÛcáBT€s-äh×R¼’”ûr?. tÉÉd…Mk{F’á܉8Õ:³:ÓñÉL_FåÞ¨$AëH KŠÆ¨iA×ì×#ó>$ª]GQ¸`ežF%ø äGÙÂ1Ä126Ž]Zk8ççrìñ‹"CJýk^Ñ®@ÀBtšyóê6ÂGO¶Ô í$ŠUÀ>ãíeY4ýų^ðÈÌžWÕmÛ궢Æâ›Uš6ØœÇ8¦9· ‘<˜¶¥>±fœ’d¹5©íí–À‚ÖbG$¦_2j*”(M*Ûè˼1[5o»Qy¦Ä\BWj‡CQ÷S {›{ÕclâP¿mW¨ùŒ‰ ù)¼±ƒÇ’×­*+‘¦qh©û@}õÃj¾J«gs'Tj‡§ëÈq„˜-“O¾¡ '½H0Ÿ mµ~(÷¯ˆû²|q^+Ec)?ºãO>ü`$DÛ—FÔjY °EF>0_Ê¢é:Ùþí–àraJáñ"PqWTM¿—µ2Ãë·Ñ@ Þ4¦çæHÊÎ^àÈbï(á'”ôÁ[«¥–@>%åê5G°Èú¥ÉF+$üÉÑí–m3t«Q{í„i¤y å7_š¾c”j±Zþû^L>–Ë09énŸ«ù¯\‘d¹Ô'úª·ïˆbŠBš“µ2Rű2êÏl|ï>£!·´€úPŽÞ=UY†ÄD½Ù6bKæäÇ1#„ˆÏËÓ_S¨“nCäHÈì M4ýNÒ ,kËz¿­I$S®D‹NÚg}§ËA”>T¢Y „Î8e+û«„ö,?‰À (¾5¾•Ì„Á]i_ö]ò[w*çK˜«²0ðߧߓŒØÀ/l®¬õkM+Ü[’ÑØH¢¬‡¦Ù™Ž@†™ÑWZÐÄLoÊÙÚ”û±OÛ%M±ŸˆŠ§¶Ùx!¢ˆ@Ýék;HË9CB;äø鉈,ÓÊz•Í­‘Ó/ˆ¼°p[ÜüATõQ_ÙÌ\Ñpۈ׹[Xü¶ŽøýË—Q‰ÐR ÙZ4QÚ&ýš+ ®Ìv-Æ1<’«m莋¯^ÜLêKIifŽÎäôRÌ(©îNYx¹¡Ž¹–i¡k:AŒz4öÒŠÕÙœ”=Ùˆ ôf,Ár#Iºê·RHȺ|°Ä»,…×â#¿Ðd()÷"ývôÉõ+Ýzý#³ ‹NÚÛÔ–(Þi»³îÛ{œ˜… ÐHõ/2ëW,!õ…¼ÜõsS½Høi– AI}¾•-ýÂÀS×cN5×Çl²Àj%è^F²³¤· =N¼cóÊ'”¶G& 1ü$G éÒƒÇ)æÚ ó›|Ï$?/ÙENZ8n/¤¸â?¼ôÛ~$ìŸÅ—c šJ­ü·­Å§}oÎZò(i9)æFÔ¯E? ‘”G&º”¹–µ2ÇWšØÙ_z ÑË’ÞHé@LOÅ׌'[–R;Paú‡å¿•Úý­-/×Ucžcñ,T-M¶ôùxæLu2“,1>ôÖo/K?VÔÜßZƒN«@§p¨ªñýŸ‹*9,ØmŒbz·å¢ðitk©¤‡¬–„'ˆãÓ2qêk›Tð‰r@éºTñÀÚy»xÈuy#`–†§n¡›£då’÷`"FÉùÔâ´xDj !¨bªåv߯Oö9W “g$¯Só‰Ÿ\‚ÞþÒÖ{IH¬²Æ¯#ÕcÒ‡l»Ÿp×›5 ŸÿÒæq‰%eC·-€Þ9¸'Oe=µ¶H£Z’HU{±ùöùäI)¿4«¨;ÏQº¸†­Aöy¨?Õƪ&OU+x”Ü»ŠRzun¦™`E€ëËgyy⊢¤ôÛûrA†Èyäye"l‹‘­ÛµXï"1β©ç ª½ 2$&‚8‹µ@®ç¶H[iU¬zߨ$õÃÉjü•`‡¯V©Ãº(Š d|…0Ro¹ %¤,j‡‹«¢¸­ô'²€B×6$uü0ÑFÊC~‡ã‘!˜)þ™³[3ü-POJWúeròfY ôíŠÂ:e`Ùg")#¹º_YÐ(¨õx7qø(«^' f±R†­%vë%´è›Þ겤$j3Ž¾*ð÷lãÙñY=bŽâXö#jf@Ø8·½©ÛÚH’L9 U“®ý+LÈ 6žhZu»z—Œ´gâµ#ð¢ûœ«$&èDöHm-A¾½¢ãýÅè¿ËÓö³ÉäÜxcº.Æéçhu%Ò §ÑQZ’㉨?³‘#¢‚Nì3SÖ&m^x´òÖæÍ$«J³~Ð'ù}³&¶Ý Ï}úT“ˆ®n æ;¨Z¸·#Ô‚2GîDrMìÿ3<ñj¬Sw†„w J¤WaR9Sý–FZXƒÕ>ÿ•É1Óâs§B—­"ú·$—Óã"¿?öYAÒöÁ–=ÉÝö‡æ(%^µØ–«-¹oI‚÷_HSàÊd%ÉÈ2÷+Myå{(ÖÖS\ŒiQPÀS®žJLFÌz÷U´·sõPP°§µs"0—V“09$7æ_V_ŠG$±=ÉËãi‘µ{Fdä©×aAÛèÆreu®‘u#2Åx’Aûò³3¾IŠé¾ŒD±<›®W)2DŦÞ:Deh·öä8Ã:)¦— %'Ô›’!¬v«ÐÓö¤?Ëí'¹'Í 4Ãæ¯05íÄìÚeš„DQð]øF£Ää„Œ›Ï’™uŸ™tëZ~Ãêø‹Ö”©ï’Çw,dz1»ŠÒFKi囃|SƒÄ±¯ìÓ¶^!a¯Ž¹'šWæ¾½åø„vÒ™ÝÏKŠº:ßlªZ@YŒä3­óÛ@Ô#~d°[º$êöäŸæŒŽKôf<ôÓŽáº9ÁÙ9o˯Êÿ4CþŸe ¶ãu—M˜ÃPz†Ž´ü2±šc›>žHi¿"¿-dm…õ«ŠíëÃÂ5’_ 6«ÿ8÷ha¦‘¬²§ì¤ñ‡Øÿ—6ÿc’Ž¶]XKMŒ;TüŒó¢;ÚA  Ö–òŽDø®N'/Ž¶%¬éä91+/j6˜uYl¦_÷T¨ÑŸzÔf@È&£9… xÅãö"û âþ9=ØUrC¹¸’=™·éò‚Pid%%Xö>Ç$I©,d“'Ê¢€bTn¬-ä1| x­)Jÿ  ‰"íåº0ðu,NGp6ë”bØ ©FòÍœZ¢¢€Ô`¥1J®tɚȤÜ ìÙ‘M$W$JÛ¸úqé!Üñ°ŽJ“‹©,œ@b ‡Çå€U¤‚FêRƒÒãCBjMwù× (á§õ)f’6ý±ö8P¿–t˜Ò8$Ô¾)­gj^DþÛ“ÑW0³dîrñÄuDù¶ Kx’hÃÏrKˆ×yea²ÔuHÅ{åxäW(®iµ®K¦Ù,> :‹!õ>Ì Š§ò®]Ùk™¡ÍˆXÏ0\4Ê}B8Æ|db6oòE+™†=Î8‘¾I§—å´aqoz@YÜ“ùe(ür™ŠäßJP2ó†T£ªºŸ–Çv‰ù¥sÁ*? µ]¾Îãq’P´»¹‚eš&håU⌧‹qï¸ñé‘œl„«Í6Òmï/¦wˆç¥Høúï¶ç+5ÈY ¦›ª]"ÕÛ‰ …V42³8Ž©á)­·“<Ëp¢Ca,VäŠ<£ˆ§Šƒ¹ÈËQÕF w27Ê‚$’Ké߈¡9‹<öåGmÊò‚8ï¿wЉ ¤Ë½•&6º}œ?½`“IZüjWéÈ™|—ÜÈe1"Žœ•x×±>äŠûNy$á…¼ ¹ Õ˜{ÙldÀŽö+çMpØ@š&”†Þ9™®Š’€î»SíÈÅ#»^Lµ° &çT½¹VŠÄlìÕ?<ÌÅ3%«`ËluãP®ñé((Á»Ôä©"h½"óSÓ&Š{+Ù-%…‰+_Ÿcò#*–(Ë£(ä!éž_üåóc…†öÀj觋<*V`=øŽ5Ìš@:¹c1!éžrÓïˆUi¬g .£**|XT{fñä@Ú&ÿY„Á#Owå,¦@QÜ0ê¹Áœ¤Ägó¾­o,XT²8ÕtÝHä¿ëeÂ$5_“Ô<½ù —Ög³–8”€ÒÁ+€¡eø¶¯|´eµ˜Ç¹ Ô´O#˜ Z^\ÛHµ4—Œ¨M;ñ Ù|rÍ„z0)"n<ÑY¹!Š€faÆ [q •€•êÀôïLV芴d$“4kÃMœ~C+“dcÞœXJf—‚éÜZÛ÷žÃ¡9D¶êØp¶Aof†$–³Ù¯B%ˆ‚ñ9Žgño§O¥À¨eF ËP ‰ÈÈAÝè¶LoÄc«)Û¡Ëc”°–!ÜÆïl¼¼®\NÐs$ˆH-@{ ²á9®”­e€4s¼Mµy¡ã¿@Às‘”žóʺ„-UD• xºWjo¸ÉÇ0<Ú爄$º6¡s07ÔŽ™!0Ç„©•»OÂêWì±®ÙE°_U7ÔuG‰Ñ®”ŠÏž=¶(ý?JQ¤–’¬—–Ò_‚¿êžùN“Øæ¾êËRZÒÞK("eVf?ʾ)‚+†_ÝË•PŠø½k’=ìSXg’ÖÔúÓþø|"09V?ò‹ ef‹!:¢ôÏ0ØØX ´ê­Â€óof=>C ÆJ„R]Jòòîaqpþ¡`‘ZwÛ.„DXJFJVè*×’ÿ1; ²ö`h&ï©…b‰©€°º’>L7Üä/šL©9Ò<ó¯YºÄ×?\‡¨Ž_ŒÓ¦ÍöÛ#-4K(f!–è7ºŽ£?²…†·Ü³5ä Ü{f,ñˆ·ÂfI¥¥á-#]ñjÍÄ(;.+¸ûYWfA*²jvá„pÎde²t?F"6ÄË¢½®«ª4Ž¥)TýãÖ¶å~Y>÷!có$—â(.­O¨±¯©ÅèÉŒt-„¦˜ÍumwÇ!| ªßY™IV½]²Qm½ÑÚ…dÒ®ŒÀî.£ª†?äÓõe¼@ó uÜ•¿™|ã`ÏëÏ)Øžƒ}²ÁŽ¬™žûÍíóIëÝJ~*ª‡`)ÐôËã‚!ªYdvC-åä2I×sWbztÉøc¹g½F;­J9Òy‰BŒ¬Â‡ç\|(÷)”»ÓíÌz’“o, q a,wÍwøìA]²Œ˜‡0Ù †éŸX¥µüPÉoO*’ÐÛJ¤Q€Ü#xæ ör†éý»Gë¬Í ÙÞñôùÒ«òje%(›­{ZÓeQ5š\[õç”%{¦†¿äüYY’Sk `_D²E Ñ£ ‹”ibmÆUN|Jïüµ?l¨\Ò° ‡4ks·Ýˆfk¢©H”@ò”:Ÿ¿ ck–€˜öX†ãæÞ9YN–x ø¸ó—ÀìÅ<˜G›§»Ôå::s^F!Zq¯ˆØl»™4ÂuMÃF¸¶¼ú°køÉq)Ĩ£ö¤?´+û9–&NÎ9€Êk¥ù·Ì07©ª][ÅÔ‘FzŽµé‘–ш™ø&Kçë áIúIb–´ »PÑ¿ ¯Á=ͼa©µ«@ÜÛ°»ä EÅþѨ{à᥌¬¤0ù¿ÎÒN9ú lì< Wìò'—,¼c…sk2•ù2í;S±ºƒ•Ò@˜†nJ@ozS(”Hd%h†µò¬Ldxàf?´áM~Gr—g ÝÿÔç6òË)^û‚ÛfÚ"Àuònù²øƒØA’bEa0+s$‘òz€öÃLFJ艷U´…9M (=ÎDÛD¬,¾žâ«oÚ0=è¡šWôP3K° v÷JD¨®’Æ~c‚Pw¯Ïç‚é/gü™¶¼°‰Ÿê[Þx_â~Ã×ö 5zÊ%Ù`äôòí¼÷71iEyr?Ò%$±Ê;Ö›Šü³Œ×6\Ñ tñ´~”ö± µA·‡†!HJd¸Ò 'Õµ@{7¨Ä} å€Öv觯§z¿ QþE*)„Á% æ#yw^²“S/›t”åw,ø: rcÐS'‹Q(šæ×—OºQå_2~XùfÝ‘~³5Ô£Õô°Ðקü \³$rMÉŠ ÃLó‘µæ i¨FÍÐ[»4SþCóPœz6ÆŠícòÖÂí¾»kkÓ®ì@< ×–f#dKìrÿ@²‘Dwš*Ié0;rG¨ìÔ¡§Šå±™ï`k¨_™Å´Öv¶qY¤Êk ¨QSÒŒ|#Ô ÄLVò¦·wd[mÈêáMjz€zøŒ¶€,%Œ‘É,“òË̉f.4„…þâF>¡oå ë—~j-g¤ãEü»ž³êVôãOïË{V•)Ë©'“v,4,§ÚäZUª]C \êœ)n¤…n>*¤ü(;3±Ê Ie-˜ÓÚÙzš®­+½üõj«{íí™Qî  nX6±{Ó‰V2„µXMvZõ-üÍ™xáM•ôC\H'¾À<«âÄni–0‹(cRõ£ ùcÍA¤ÏQ”\D„ÊÈD¯Øí@N@ 3¸´™„ª œÃI( €TS‰¦à÷í–5 ôØWîßNFË*&º·Ú´ÖÏÅÉ Ô%v'âR}ûeYaaž)n÷7óËCv÷’H'‘½-?T†S S¸ÝL´oFé>Ë©_í.jŽ3nÀ”l¾ÐÒT³¹¶’ïSjþè œšlw"•9¤änk£ª-`–!QãZÜm%0U/4d~¼C•ÂÆdŸ$r>€Ä„ñ î¯ØÊ©gf4ò +\@ïbwä…ž_8©4H㆕›ãÛü‘“*o’Y|n® x癹¸51õR|2@n‚Äíô»Ëë‰%¼ø„.É IâÈ¢”ø³,HD4ñ%ZÆž-d¬ @n ôç—ãóhÉJ–ÝõÙ˜÷=}²Ý˜QsÎœˆ†{tÁkFù2=/SòäÑ%£hÑ´åUVw.ÜÛÞ†ª[1¦'ÞäÄŽæPš^šñB×~]6­p†êY! âàà³SêÛQîküy 2ZÝ¢B¿£ñ?p;c㎡N ¦:>™~€ Š»+r­GÓ•LƒÉ0$sUÖÑáô(‡z½Ç¸ÈÀ6H7¥h2éú¡Ô4ba»Mƒ~Í+ñÚVŽ[,–(µŒtl2ýw^òÆ›¦ýc\ÓDpxý^V‘ˆ©ø W¾cF2'fù[¼‡UÕ4+‹©/ô½.[T~êy½Aß~ fΕQpe(ó ö¸òŒ±¯ÉTíò>lq€×)’“Ï<ÓžDq­*w®LÍžHg…ª8†ÛbHïß",o$·eXÙ£RÀÌUˆ$ Ó¶U0 l,3ØüàÖVê Ô˜Š\±ùæ°Ùä䌴oÍúéHÚI–âÞE'‹"õê{äã€19OD¶6]Mn`XªÃrGÙ?? °áˆÊTn.î>¤J²JਙWPzÔÓíd@ÈËeM;Ïö°ˆoÑ/Q(Ÿ+'÷ÚïO|ÀáÊFÈ¡ç}"f#êÓG!4U`kÓ}²³€Ž­£/‘B>±}xäÚRÑ¢f^üBB=ÇOlF:æPr·34@ºŠÓââÇ"@P„«2†ú¼o˳×Å6‡i-•ª‘ðaöx×o–JŠ/‹Xº…X 9ÔÔ‰>*|²<²2¥íæ{E`n­jÍ$f´÷ áðÏBÀL‰ŒM¡^+K«spNÔÀä=A·ÒP~Y±“‘Œ'j)<—ÞòÈå,%‡¸òû¤MA€¡ô‰©±Ü×,Ž_&³Šú¥íct­ézlÒ6îrñ”Ÿ ®]'Râ‚J{)?<'${Ñá”uµ½äW!’Õ̼OâÕ=ëJxbd+š8wä›Ù/˜æãèˆá Ô§ µ#¯Ñ•¬ÄeÑ›i×·ÑÚÄ—S"¨HÍS°ëA\س“ EI-à`ÎKÐe^ ²šŽ›à¢q_4¡"ÚßÇ{t‹8â€ñ†)ãÆŸ´‹×&Ý!íî µ¯èøõ;tŽãœbH#‘¦sJÕäØ¿—&wèÕËdJKëÝ ©ïíãQÌ‹È¡â ç| ù$¦6rY]ÜÉw¬ZÚY¹ #3ÈŽ~×$ Sã‘2ò^ù£&³±WxÖýïcâ¡ÁQäÇÚ¿ DHŽŒÌAê—Må­MnæYË0¥€ãÛzåðÏ.æ™aE¿.ªBŸTô¥œ®XðPhÜí¸É AêÇÀ¯zY=„Öü‹BÅy3ÉAVéÈWíež0,x]·¥n/,îFÇ÷jYI4Ù7Èåw†\R‰Ý›ižyó ´J‘—d¢JŸö4Ìià‹‘â–C¥yÞîæÙY´NÀòJ°ì~ìÇ–äψuU½°Ðõ"¢3Âf‘e_‘8c"J uÖ…5Š´‹fd+¿Âò#$'háaú…ך.'šÞZ[Ø} dª*mÐw?ëfV8G›L¥#³¸·ÈÉ$¦’? µ=¼s4SŽAZö¨jU¨Ã`Ç·Ò(qá3'’‰Ôõ[XÂÁ},IÜC,ƒØ 2' DŒ“^åä¯>iWZ%…†·|²êQÆI®Ccµ]~*µsW›±ÉØÆbCÍ™A§è“¯8å… ïf ìC Ç$³#âEµŒ¹’E#Ž"6ÿ'|ŠÚQ×®­¡õD"ÍTñúÍÈ«ŸòrNY»ï``Önc¸¼3ÝÝ’Ùä5ŒuWì¯òþÖ][ LlGP¾Ô®'21ÜÉ´³½'Äû*æT`Q$¤Z•®›¾­ô·3¸§À ׈;Peð'£TÀê5”+p#D.`µ~ ÞÞ9’­Ú(ŽJr[…œ92ü%i°+áï„IŽé¤vuŽÞR„Æã•7èvÊÌ›HDC§ÚÊLHÖB|H©þ¹ H†@QãÈнÔL.‰ˆ†¤ÅE9/ññÊÿ5äÙùu+o%JÂcwŽ$«¥ æÞñÂu;1<ÙE¯–|¡õFk{yš5VÏ&èIßìÇ–y—"8£V¯¤húm¹&ÊÚkÙni+ItÄ„£|,Pý¢=Oï2©Îù¶@W$ûGÖõ»®]"†å¥‹;Ä£ÆÉûq7íÆvVãþ¾R@giÿ—<ñåíqþ¥ª[V‹sqhzŠBÙÀ…ˆ¶So?·1I/Ã*H§þpm²¢[{ÑZÙÛ§¥o<0Q¤,¢F§]Í0]±÷1_0ÍäË]ݵËò£¤ Í«Ö‡ŽàûS,ôc &:v«õfÑ Û[ÈKJìQÙ‹…eú2Á#h«AêQÙZGÂ;µ¿’-HWæGÙã]òÀIa·D³RÓ㼶’6£ ‡‚¯ÔTm–BD0œm€]ØÝ[; ¤(AÛmŽÔÌèÎÜc 懬D…InÔì;äØšépNÒ“oe-쿲‘¥~`uʧ :³Þ‡åß+yÂpêÉanßn'_ZS÷†ƒ’AÉ…–ekå±ÇÕ²3²ô˜íÁÿß1¸­¸Dªk>[ÖŒ*!8Ÿ´‹*©>ÅÜ‚FÍ™ºcW:mž˜ ÚåÌQÊh±Û ^œš´\°HƒW Ò=Wó'ËZDF-¡zÇt}Z?¾)xäÆÉ$c×w–k:Ω­ß=åÍÛI#ÕbWꢵØtŸ‹ˆäâäÈdy¥-nÂJÉ8$@¯JåÌ*–‹høñ¨Žÿ<•‚Ö ˜È` mñÙZÖÆîéøB¥˜u><„ˆ Æéå¯å‡˜/ 3"E GÃê7dì@Û1¥©ˆÙ¼b™H.Bè·B+¬]ë:­VdRT݆¿ìrVd6cT{Ù>‰¢ij³õ-fô%ˆÒñ%!Ldö¥~%?͘ÓË(¶Ã’Tòß‘´°Èú“]ÏM ¹„ï^;|]78cšräKG2„ôŽµhÖ: ‡¡g>«ób+ñ1!Wl™Ûyƒ´Cú¤qK"²MaÔû×-ù5˜£V9ÂbuG V@”¥{7¶A–Èhþ°UYÉä<èFCfÏr%èe@§‡µ{åežÊ•Š%ø—€n”Ü|G†Ecßh«yMJ¨aãò˚[,wñTå‘`Pì“n$Z®NØÑ °[‡FT~¼M=«·†DÊ6Ó¥Õ,YĤÜÛbO%ÈH‚ÌB–7šn¢›÷ÑzgøÆõEíóÃáZ8÷RmfÚuy¤õÔ7.ü¹wڔ뒦°ˆ¦@¦w·zlJïõ¶2Â#^•n#r¤1;1ÈJÚË]bÕ®òfwŠ2HˆlÃrµ®Ë×ãɘìÄK}Ñ_7 Á)ú² mJYØ‚)/üWáðˆeâÞÉÖ“æi4ËçGŒË:ÄÞÌH *òn˜?z}•ÊåŠÙƒ[”ÖO?ßKH®hÉÈ‘!1Š§ÂŸåec gÅÞÆ/|Ýq=Á3Nüf•K•Ü×áÛaü¹|q jœÏÁ|º«-²Ë2Ð\ô¯)Œaª¥A¯XÖ貘ˆõk8f6ZU´辟¤¡¥âw-Í…I®@ÂÎåœ%\‚ŽœšäÒýfäG#¸.é2Ö¦»U@¦JB!nDîÉ,5nŒ  Z,TwëðÿLÆ–8–Ñ"9#4ÝNçM‰Þ%„+30Rš¬j@n½rì±”¹¤žgóg™å¸¶{•UC_Jœ~!¸$©9n<ê™e¡³½üÐó¹ýÕÕñÖBÞ˜Œ"ÐtŽÙxÒE¦Z‚ŒOÎo9$mÌ‘]ó ‰Xqp6+&ÜvÀt0<¶Q©!ڟ竨ۼÙ$!Á ÖîTàÊA忾#CGš6GF×SLŠÜ‰$¡#sá™°… q'>#j¦æÕ ¡GYêÜMP­<í xJ/dUŸ˜µ6·X$P-þÅHe;Ñöø¾œ,£:dV>nI-'¶35¹ºbîX’c,~!7ãûKü¹< ÑÊ·Tó>­¤Ïo 9šf2‚wäiÿ 20Â$ÎS¡h?\³Õ½JÜ,38'곤S÷oödãÕUþ,ÄbˆåŒ’[Í^ûK»x •)_ )»Òå´e‚÷OY¿ßNÛ¡Ôoò8DŠšXº-…Èo¢ôySÑuW!h(CŠŸø\>"8Rûí7Ì6–‡êÓÛ›N‘5±f¯úÂMÓ%‰}®éº½ÍíM'">°Î6'ÛlÎÅ8‡.9t,GQF·¸)èú³DxЊSïÌÈ›q¤( îå1£ÅÂ6oÞÜW¾I¢bÒžþòcP„?ÂÊ É§ŽBS Î0³³Òtß#[DRåd~aGîäÔ÷é˜Ô³—b=SÄšòÓáŒ#`Ši¸Û|¦l Å—™/!ZH¬Äý¤V YÄ –ßkúSJ®Ð´×ˆ¦òD'¿úØ#Œ±‘›Ô¯$¼g*Œ‰ÍO&þUÿ'2")ªA)}"hã.Ç°9hÈÖ"„k+2A‘ Œ§v`xä¸Êˆ†áÓ4;™ÃĈnTòBj¦¾ÛârH$B$ì–y—Ë—É4בÅû‘g5ã^Ãü£–bÌ*š²â7iVŸm$+£3Cªíð¹ùÚa˜ŒbiÇO¹»ºõáâÖâ?ß *vÛ©4Â%H ”ßFf433Go°õ±åß*˜Û O{1Òô›F…žÜ’K~õž; ÔéÉŒBµÖ‘„È~ªäVhöe§¸È‰ù³!uªÉj‹óqJŸªÞB ^³_òp“lQzŒÉkb²ÞD£oÜjIÁ½Éêµû/Ç+êØNÛ±uó>}yMU~¥2KÆ Ûb0m„Ž¤q~+·%ãË. m»H˜%2ѵû g7¶·7Zl3þ÷Q¶Q:"nIdSUeQÑg+–;f'ÞÊußÌß&ÛØÁs(}ZÂétW‡!Ê¿ «W…>._g*Ž)2‘‹¶Ô¿/5‹T·¹IËÜ,”¼aF\QDt[Óm¾?³û9gª=pDòO5Õ·µ·{(%~ÄIñ§]ןî™–¦@H’ÈŠI´­aµ3i¶Q¹Z‘ë1NO_‹”Ÿ´ßÊrÉO£ãt‹dÕ‹¬0B׳H@HÃ*´u=\TÕ~Ö <Ó<Ÿ¦}MßÌÛ¯Å-Ä•·Ž:Ÿç¯Ã÷â3ŠbÝ(¹Ñ¿"ìnK­Y™êÛC3Ê„èx©<Ùe£>B)‡…Íèz»äĵ…4H—Ñ“ŠCÂ#*ŠÜ/\Å‘7»páè…óGæN™£éÍ=´oy*³#Çm˜FÉÔ;- |NJ2;)˜á~müÇó/™nCO,°Ú+·µ‰¸*û,xÓ“¹Ÿ (­ÜYæ$¥7·Úî¨êîæâb»ÈÝ…:T ÑkN¹`ÅÜ×,„ ÒÞþü­¸ Ìy˜žF”«G¶Ý2U®òê—Ëm=©e_µ¸aî=¼rbWɨ Ô=G=Yu? §íœšÈº‹iò°/±b9÷¯LÂŽº’ ‹b[*h(=ñI’´?Zšf(Œ €=Žø“iþŒu=O®_Àcµ „bZCöB¯\ÅËRØèln•µO9ëÇJ¼cÊÖYÅ!ÆJ7ÛaüŸÙÊc„[i˳¶‹›ªÆœä$Ó}‡½s3`j¶[§Øi–s^Ü1;pœŠQ«^ÔTf>I³t@ÒiõëÓ0¶q[DÀ‹tT”­Gn¸cô÷&–ߤ,n.Z1 ø¡ˆÇ\‰¢ÌôIj&¸”Ã!IÕåδÛjPuÉ‹a*´ z’´R7§)·l˜˜lJ¤ºœHªP -Ïl!˜£mõæ KÛwI“ír§!ÂÌÈ'FÔO ËË$$|.›ë”]`ØA ¦·dfÍ*;µNKšì †NãúcÉnú¡f¶ Jô9.$p¡9Ë ‰'b£ñ#%wÕ»‘–ú€ C šõ,„¢˜­%®™~†7uG&¡…* Û¡ÄH„Ê1)5ö‹w§¸•cúÌ Qê(ª€vþ\²9/› ä”oRèJŸã—Ä´Èñ"þµ#¢)`h(M)Ôây¬Gšøåe$‚K –G &šo˜uKV·”ñ]¸7ħèí‘”d&Bë­jæêáî¦4½Ô\FJ?JSá R˜06S”ßMóÿšìÓ‹PwŽœ}+€²¡éF#-§ÅöCü4Øö\#O#Õ|XŽˆfüåºXǤY4”§'æÔ=˜©ø~ŒÒôxã¹*Ÿó_ÌÒ„,–'áG GCþ®Liz?0;’…ó}óMq5äKs$í^D•àiÑÚ™wCbÓãYÜ(Û\é7œ!Ô®¥·5bfáÍ@ª¤ úþÖKqɉ;î­{å»-Íž­o( ´a¼¿Éî)ï†:ƒÊ‘àv“JèŒWp?hl7ßa–ƒl o%ìA±6æ=úw¦A v'avá#QEH Ðᥨ÷SÈ%ftS±&¤íá øWE » W|%‡$lºÎ¥qK™þ°x¯«F*  Çâ¦Ø1ÄqdØ«ÿ×ô$>`Ó.ã†éd’%d·w¶Ì-ØJ1k: ûH‘\ZM$`4ˆÅ”@-Ë7.Jˆ:\´¤HÛÊ6Û‘8ñ€µ4­*¬.'©¡ßõ`2*¥ÓìlެѢ ¹FîML#tÑg¥¦Â ™žE 2·.g‰®6W…¿_JAË×*¤Ñ˜€÷Çv4¤úÇ–À`ukeâ*yN«Oø"1¢šTŠþÞeccqot½¤YQÔwâÕÁÂSlgÌ·_˜‘A+hz•‹Hœ@⧦¢¬D„²l:×-€V¾7×¼õù¯¡Èþ’©ôå†â¦ŒÁ¸9Wý’æ\pB\‹QÍ!Ì3]'óKË:†‚5kÍ6êÞ(E{4Q „IXT «z€Ù%s&Þ&°ÚkžYÖìíž®a„0ŒÇv¢*?‡ïTuÿ[*õDîžÐ§‘´ÝQËLºuÑQı%eûÇÇ.†¢C•µËJIqù5¢4 Gq4LG/Fb‘[ýV“‰_§.ÂÕùaÑ‘é—ö:J¯Õ,ä¢ä™b,kâç‘û²Œ™å&øcèœC¢ÆO&Óy±ûa$Æ™]”‘jÓyfÛ1Dêj8‘€H±”Rû¯*)GX$(çnl{ä¸ÈZK#òŠÁ»Å$Ð ®þ9/DJ!´¨…6ƪ>Øw4ÁÆžAM’r71¼ „UTˆÑH^êÿ³„E«/tå¶å})å‚4g–rGÂEQ©v>|O6<%'šÏP±¼ßF2[²ò ¨Šü¥Z¢ï°à~ßíeœDŽj tJõ-bI/cµ¹™ "KEÂ:úE˜½G"2P‡V&VÂôÿ0â»Xê¶QÉm!y^X ³/% E~%ý¯æËÌI E—Gå8§°ŽûMq zÑMV2å íËöX«Æ7E‘Âá/Ô´»ˆyiÏagqC5íQý£ÈmþÇ&%ÅÕ/$ëAÖ¬Úrl.À_ˆy©~½ý‘N­•N«dOs+[í`Y¦˜@’’¦9ϸ¶ß¶c[z!åµHa2دióŠËdëGÊwɉ[ ²K¨ÝlHšÔ$°›ª×ª¸;š:áµ#f æ Mr÷7Z;˜ï-Ø›.^» HŠ†ø~<ʆqÈ´Ë«‚®¹¬Y¹'–ÞU,H£C‹Vž#2†(Ú|BˆÒ|Ã5Ž¡ ªº—ÿKä‹'©Œ ‹Åª¤^¹ã±³(š,óU´ü¥ó~òGF”Ôí/ÿˆÆÙ‰’'w"Q‰äT,¿*ÿ4ôA#Ó#&9þÍí´Ëèíº³‡øÐ’É“9¡!»ŽQ;=³HÑ5Û2ópAq Ffú«’®Q~ T}þ Á–Çg&‰ Ü]y7GÞ飳–[¦n#”ßÝ% æKÿ«ƒr¼ ôÁ(¬š¬ÏnÀ¦Õ<€ÙŸ5¾„u'¯sô ylH,%WèGO×l†£eUXÒ•† ²‚¢?JoÛbE«ŒÎ÷–÷,È §5SÇ•7|„óDŠ­Ö8äçfQª .UÕ§Žhl¸®mA†TB~&…Yárˆ“{2ÉU» ò«ùv{½B}.ÒÿN†0xÍo+‘Wp ÷©ß§íeÙ¨[<¶LÿIÏé¬ö°ÙÏÉ£šÞõ’6ä§Åð;ïɆõ2<Âai¯yºêåmn´û-ZFFUŽ3oêŽ'ísGMñd #Í—Cë7:œºy{+{Íú­û™í[I >Pê9SýŽ{òA2­’=ó¿Îz{(Õ-’æ¼ëXK ˜ËmÈþË-–’2úK\u5õëQóRyú(áÐõ»⣲Ê^"ýJµÿ+!<P¶F\{ÄÓÔµ¿=é7×¾¾¼×wì®&2¥ð­>y•x¥Ñ«Ž}K(ò·ç–¡¤Êðù’3ykð¤^‹:0ܱ-ö“²rŒº+ú[ᨱêePÎ@ynKØBXʺc¥fºgýâHdGOŠŸµ”þR}SâÆù쎸üíòl3L÷1 ,Y8PòôÆê˯,€ÓϹ'${Óï,yïÉÞk<4Æ\P»$°…tôÈêH§ÂOþW²'dš51'š8<˜î£§ZÍo4²¼[8I `µ6—®Ç,¤pŠI%±Óá…\¡”?Ùe$NÙp™-\4…6d«<Ín –æ@" Š uÂe%ª ]6¹ºW0 ð¶ÝAÃ?&B£-…äŽÌ¡\Ø)ÐuÛD B9ç†Fuäw#°¦ nÈzS;-u$a  ‡sðž£*”FI—×£°VäXtØS|®!²v9&¶wq¼1‘öJŠpH,di0ŠE¨ßq×éí!6·t4«’kúñÙˆ3‰£"kÜå{¶¤BÚÛIBR®TƒJøä”+Ýi1ßÇéË3TcAîÀœ"TƃOäí>h 1Äû;ú@ÈvþmºañÊ<.åÑþ_Ù=¢[Ë+L뿬ªªÆŸ³°û4Çó©ÅÞ‰‡òÏËþª½ÊK**…³€¤aüÉ胄"®/|§0øtõ€ôå’/ÓÔäF¢}ìŽW$+ùÉ°¨Ušy—rYX5cáÅM¼³¢…hítˆRR(®ÂI¯ˆïL#)ï`aÂßE6ÖÁ-ÄMçô×|kL%–CÌsVÐǦÇP×&ºrGñÛ±§á™Ÿ“ cÛšQvÖÐÙ<£@$ÅÍ”7‰*^î\{­‚L×· ¢+}•^U#ÄrΖ6B%Ô^•4ýŸ£-á4Ê\ETÒW’Œk°ø½ûäLYFEKër+rV§&¯PAú0p²â¶þ¶Œõ$Ôý¢Oã’bH5Þ¸5ßqáóÈð¤ã ’vì|pð§ŽÚæ|>œi~Nç¿…NǶ ŒO–Ûoˆ¤nîc¥vë‹!ïw¨zu#§Óˆ‹.3“ôxa¶Mz‰Þµù K7w©¿|)âšõ ;ø,A¦ýF>Ût÷ÅH%ÂS½7é„s¤ÃcoÿÑå?¤Ü¢óoW‡©Jž fÆ8è]âÚè5i–Ef!¸©¦ÛÏ$qù1ó\·±™ã7óD¯«øj>Žø8v[DYɦW0³2¸.¥ÊU<¯OYBH…Õt?ÑÍþ‰2_«HÄÇÒXÉT©Ý»Œ™q æ›Ç¦ybâÖ9?I›iä€4i!,uþñvéÃ+â˜<™˜F®Ô¯¼§smd·D<®üAXB̵aR9ÆM ÙÃÇ{1£Í*¸¶–P· iVUøíÕÖö9 Y Õ5 )$ÈÑ3NTmÅ+º•jäøP™N´:jz]ÃOe*Ø;£+˜R¨å¨(‰ãZÙVL·cÊG7¬è_šÜSZë–0'+]ÅÃ"«4~ÔÌ)i¤99$$7GI©y&k¯Óº4±ýgLG_ªBËð•E]QÅ@¹ —"͆yŽ{2ÛϨC¥³]P5¼áù5BÐn~Öeb=\l‚÷bíi4>²¤áñúRž.v#S÷æTc®2üÐó"3¤÷Ó¡s¼ÑžV”ø|' t‘èÌjIæY–üëqy£=ž³¬&§4²Ÿ«ZÜÛG/ãÁhíJÛàDñpò ñ•Š%,×ôG´N[ø‹wpÌh‹ˆWÄk9ò¡_°ßN¿6¹Ã‡—¥!ó&‡æ8]õ+›q-´ô-iûÛfî*ëöŸi_Ž]$y5Î&ì±×šV!‹oÔåÀmmd•ëu0d£(Þ¢5:50§Iys+»;y+ÉÏRzá ÅÜŠ²¿ŠÞ"RIRbÊYUÙcuiX/Zä' èÙ S#OÌ3C4âÞïтゼc“' ¡‰øxí˜ß“‰m–¤¡âó_Zk©M×ÖMÌ2G¦XiCüª2~ÔG çÉ¿ñhž@·*ÒFÂÉzoI*׊»äFž™øÁ-¼»¼–:‹Ç•KqŽbÄ!Üý¶Ëa:5Êg½iõK˜#YS÷‘¯tü»É¹5©¯LŒø‡&QŒO6µo.Océ3H !’ ¡b*@"ªM1Ž@vD¡[¦zG˜|û¡XKú:öa§… sm'ïa [8>Ûÿ“•Ë l%I6«­Ãtâæ´û³Q3[×Ò“—qWƒªrØc#®Í3;„µîez;½j[ÇèËvjóR3)Ú´ðë’<ËŒœiâ :SI ,åÓˆÞ´'¦6“±ÙuX•®ûøäM6;—ÅAQNƒ $f§S°úq Ðr~ÂP rmËuè:â)2%µÚ›t;xT`@’åg©Ìj{õ …ªúR¸i N¤Ÿß<‡ ¸ODSZÍ ñ¼¨¤2 ¡@<‰èFý°/ <Õckh®E&Q Q¹:lÇíã_{.D’YÆ uU¸´Ó‹ÝÈúŒoXÌ°*£|dÆ=éÅ·øp Ñ& ón÷OСŽÙ­ïÞæ°ú×?»‰¢¢ï¹§Žä•òAÇ…)F-*ˆØ ÈVm©óËzn‘–éq2!mNÞ‡§ÈËBû–ŸåetôÌYêÎü»å_ÑÓzׯ£Þ …a¸–õ&DnWŠ1»·#˃¯Åös&KØ[|1Öåéþpòmµ½¬¦òG¸¹,+5ô-äxOP…EâÏ˧؆· ÍEüá¡ßÛÀ¶,RkÖ²’[¦E`V>bE5<ƒl¿l{[üÅòuœ‹l¯5à Êê{SÍTƒB*ÄV‡% R–需B/šôK8gº¾ °M!K;hÇ«pÁRªÌª~ù>ñacà’Iç­.æIfµÓ8ÚñfŽy‰æáR¤ðè8º”l°a—VqE_ù—ÈÐ[­Ã$³¬ ¥ºãJTä*|‚}<Ò†üÁЛ+m=9Ür…%Zò@ÿ ½IÙ—í˜Å>e‰œz$7~yÔ­š[$‘Ýc¤$+TUPüúï–ÇîÀådŸæ¶…¼¥äkÉq$ŽI E£~ljÃ,%ˆÊ-þeÕ9ÙÏ4 …4EãÈû•?ÇÂdr%ÖÚÌðE2©VzŠã`Ã}ÀÂb AI¨WÖ†QÇÕ—Ôi±ãO„dÄPHµ gn¡ÃEö\Óâa_ž$$y¦Vú=å´AˆR«Ê$…îv§*ä ïFݲèvË!{ghª6JÔN5ùœ™l'ŸH¿ˆ3Ɗ㋯¸ð>øx‚xYÀ|Q˜åjí÷dîc°U‚èDÃjñ1ïC‘(¾äÁ5i#SÀƒéÑ‚ž´'·ß‘f"QÖžb@xÌÌ7§Ä}¾Œ‰…³u)ÅŸ˜tçn>¨Vîªiôå|2ã;¶¿€ea¸Ú„ýÙH«L¡½ìzþ#m2·¿>ûôÈHL ¼nõ¦ OaÙÛs·‡l‰ )„W$Ó|*-$SÔ„$«¤ÖæQÔ µ8íAÖ¤tëÓ @Wúº¾Ü~@`[@Þé+%IG#ÁrÈʘÊÒ;Ÿ)ÛÈÄún¬˜¶]ç£IÆ E¨þ[XÜ»IêÏh§’ÿÀœ¾:’ÃÀK¯Ë«økèL§—PÜКtÜ‚2øêGVÀz$wZ=õ¤‡×I#XÏ•Aôûåã$KAÄ{’©lÔªžµ©==²llZœ–r«PnOaÚ˜AGèfëGâ­ùûä,dC¡ØЃ¾ »“[UªG6Ôc°ë·LE{׉Tì6íLÕÑw¨*#ØäCmÐr¸¥ ë\JÄÛ\” nj?V;§„{º§©ÛÃúá1<šå°Þ€îIÃL <œH]·¨®Id rÜB\[z‰ï’ OFËÕi÷`ªA•´¯Nƒz5~AÉãúc{ÿÒâÈõ”n3méš'eêhMH¨Øxa"Ò'\× Rw;ï\‰sgËšR}ªz{á(2m[ïëS€sUe5…Ï*KáòÄ” “Í+\Õ,Ô[ÛJ be{`J$UªEl¢P¸Nmõð–àýV0§‰PXrûCbynv®YÃCf6-qkws Õ£dŸÔ fá,”øjý>ÑʶD‡TµæˆÃÁ¢U•I«© Óm©Ó-c]ËU”¯0x7QL² èæž"$‰ÁrJ‚:îlQER×XÔí ÓÉ ²zgƒqª“¸Ç†5º—NH¸üÅ+¬±Þ"̲¨RÄn´î¸8k’xÁØ…+9tö¼‹ëD›NT´¡¡É™šb1S kUÓ®®#’Ú!•e|.ÉÜM†QMÛtˆè›éÞx¼HŶªXн3 ZÜÆ •1·÷‘‘â§+žÓbÙ·õ!m<Ð4¨n-,f™,]Öh­Yù~´'öÓ}ù ˜ÂO>le ”.nt½j"µ³KMYˆ 0p±JhKsSECáL"2‰òbxO$¬ØÝÁI °ý¾¢£}M²Î Ä­k™Lƒœqs ~}°Óª%‹T*I'æw¦HZ’!Œ421pQIëL‰di¢bµ®ýðÛZ±Hê”|+Óï¦g¹tD *HT'ï?Ù‰@!§ÜýUâhÅ$Fdva±R@¡§û*äel¢{™Ež££0-C<&Ylî˜Ig>ÝQNéQðò‰8m¾3 ùÖþÞcncYFì˦ÍûØ”1©TsññúrqÃ{õbsQ®‰ÃÚ3z—Hñ¤àËnR€u;[þ.³F׺ 1û°±BjÒ¾*I÷ºcn¬¦.¥jõ¡ðÄ“².Îí^?ªÊü"’Š ª¬M>ßôÈJ4Ø%{.ºÒ--¤ úF)˜©!£¯КTþ¼1É}劺¥íÍ¥r¯ã–WsïXd®Ê{1¤q¸Ô€~cý¼Bd6j› l|cJÉ ó@òª,Ÿ´w¦ôè;äL¼™‘Õ™iŸ—ÑÝÙ%ÕÅÛi™éT1øJ ©ø—‹âÌIg ×7&8vKæ¶Ð´~M*&±:Ïé,œÙa)µ >*ÿ­„JRòD„G45®«$Îc‚Ê6å-RÞ8ÕPQx¨åö‰?<Ÿ s(çÉ^O/\[ú_¦#hc‚çêío :štøxñlrð‚7²î}Eþ§$¦ÑÝÈX•ýÝœGÅö±ˆŸTîît[ì­ÌWˆßé·<€GìñÇ‚V“1T•ÛkU!!´¶‘8täpð€ÆÉÝ ,ó”àÏÚ‚0ˆ#ÅjÓR¸´œÍlBHcx˜„ï’0ïkÞÃR\Ï<²HÏWqñˆ¥véà™¡ÄP ªõ ü0ð¢Õ­µ Q¥äÜVXÝ9R§zø¨ÈÊÊ% ,­3K$´i&%Ù†ÛŸ–<,… &¯Ô ŽéÙH€OÂv¥HþÜX]õÂD𣑚²v4Û"q¨•òGYy’k{t‚DçgŠÛ á\®xÛa’(Õó%”±~óàØÔ~9Y‰mŠR½…ˆš5W…ª°Ú”À"mc¹"º1$ô#?|´5Ùè¢ÎTPW*~œi˜6¾ÒîX$/äiÔö¨¦'’ñQ䌊ý^/NãtåȨ¯·¶;Nè½;S†ù$f*&Œ~ÉV‡þ #]ì“3æ;»@>­<ŒœR„×£uûðx@¯‰Iœ~¾‰bp#‘XàËS»×ü :d|ñ4ù0íÖ¦†6‘\°d"Œ  ‚w§¶CÁ)ñÜ#mÿ3,BG+ÛHmän%ƒ"Sí_‰ÀS§™^Tn5šHŸ¦ë¿Z•ø2gÇòÓÏ>V–/Tߤh Ið’z{ä)ø€¦ö~kòìÀzZ¥®äÔI)±ëN˜ |Ó»KÛyê!¹†R¢¤$ˆÔûŽB”…K„í]‘ç”” …bÔ` Ù…ë×—VR4ãWŸN‘êÝ) ˆ¥hY°Ìˆ‹bXéüÏó-£)k›R!¿PŽ()Jõ÷ËÆZŒÈL!üê´yBϤzqñj•`ä¶ÜOj K.ö#8*ÒþlyBh).Ÿ1•«Í ôï^µÉGÑâÅ-ÿ~Z^Ìë>”ö‹#|7  Õ…EXQÕ@ïILúw–®d´ÛÄá#˜ø–àô®Åƒô®X2Hsk"=5O*-”rNoí¦HêW‰«HÚ£–[G“€×68±Çs2ÄJ«šüLB…MNd Žn?ä˜i¾Yžòf^<"P9ÊG +Ó§¶BY@Ý—;"õ-ËÚO ÷F[‘#´w0'u ÙïѲ“–RäÚ0Æ!‹Î"I™a~q‚x½(Hí\²7Õeä°±œ¶þ¹&&ú»™ÄL ÛD Ú r >ÿ#Jâ"XØ*ž¡êvñðÛ™U-çMûW¦(óuhkZWl• _F¹):Ó KeÀ¡Ú§%5ä×#Òµë·ÑÓ,Ç´‚×{ÿÓâªÊT0ê@Þ”í\ÛCé Du ùØïßÚ¸B@Ë|@¯Jý9;ïa¸mʽ{ý9/’òæß.ã¦À|ðÈžåÔmˆA¥HåÁÎôßæ;ŒiER³2KFB6ô9ÕªA¯3G^,¼«½6¹ › ;Ôeø6cRÔ<¾xc»wÝj’UkÑ=ë]°ÐH'’óU}Ú”©ñÄ^n.Åh~É5Ç`´¦~ÖÇÇ~ù C ¶I5ëZµÂÂAr±ßî5ùäh¤—¬Œ "›` Èѩ͹1©;š`åÉjù¶„&£¦meq{(@•&„ÔW`N<ï ·:›\D«*©‘$R B©Þ´êr#ìälrB¬´ee?é–p†°Qp_[¨àñ>“ “S_Gþ bØîXnc3 <()^µèz{ã žõH­ÜÆ’€8sù·þ™)‡rºÚ m%eNrÆk#ò UIâ¿ ë¾DÊŠxvXÍð(d.kAüÇ ÉX=PtPšQ˜H¦9Eí†Â=Ë]¹ññb·'¹MƒPnJô§`N@@á+!wÚ„xƒ)4¿ÒM[‰£–âá§QóÄŸ5»Ú—úoU@>š V äKfàU#¢ime¶»Daw‰À`Ä2žÄdHÄ<‘b¼Ò®õ–ÁÌ>€ !4äÛ#ŽÇ4ÏÔl$¯8¯‰JSm½òàaÄFÊ|ÎôëÖƒO¹og%Ê$Q„YÇ«;C‘íC‘$|$ŽHô¾°Ò Û[À“Þ© ú‰n@A"$;-)Ç—íd>¢›ám<Á$ö2[OpѼQ1ŽcWyeZ15âJ!²2ÅFé˜ÈNÖˆ½×4¨ H4å›Âé3º»Ðòä|>ÇÃû9J™ÐH¢¾kv„GY"ªc$¨jºo—p°ODJyƒZú»ZÇ+4SJÛ“µOÄwÀ0G›#”òKÝÈäI"¿ŽYM\ÛýàaÔÔøì“kQ bîzb@D•~«»|kð ¶ý~X8ü™øeM€ @<‡ŽKfº-Ž<ÀÝ…iJTý f>ÛCÕîV3:¹!O  3Pt Ç{3Üéô¦®%«Í#õC?è/|òH<ÔÿG)…¤2"”=9­­6òljjÆÈU…•Õ£“‹Ô Žõ>Û¹¸ôÇ{S?­~‰‰6Ûñþ]þÖ2d#A4m­Ä¡ ÓØöÉP«k½û”[zŽ†¿ÃeÍhä¤Ó }ã q‡Û+Ò›o·b7,j™ñ°ƒOjd o¢›Sm·¦ô÷É0ZE¾Ù1»MâR„Òúdwl :)8AÓÅ "’Ôÿ^ NÎRÁ)¹Tü± (µŠu©À"Èš ™ÔŸ M1…ªä îFe[¯W~¤¢)‚1¥*í-Bš’TÈ£ßSH˜n§V&HÌ€€§äM~ŒÅ|mÂäš…¡èkßHÍ¿­¤dª­îÜŽB†ŸÃ %·EcseÆ?I\)%MßÛÛ ‡[ÝE´”©ìiQZûä©ÆÞîÒåå{§*I #@"œ‡eù`1eº"´®ý;¸%ž% …’N'—ì¸Øíßê‚|•l§Ð’`ë)WVhä£TÝ6ÔøAÙ×ñ•kMsW³eô5+¨b™@+­P<78|(žŒ|I':ož5ø®ÑÖä¨B¨n¢I‘‰Ü+s¯óerÀSÕÚ—™ŸR´xï4ë9î(Lw¶ß¹`AܲC†8«ªË <ÂK*ͳE©’Še¿ÚZ¶Ë…uié²J Š{ ³¦Í|;îÑcÈÐxaH!Ä’¦§a¹Î+]ë‹Ì©£m×nûbA›Žc¿ zq€Š½ähëe…bPVž b 8Ì„=ÅÝÅÔ ÊåÚ€F½ÿ*äÄ@c)„P|@é¶ R%ˆ ß¶ FE²Iß¿|;"‰iT»AÉÛeTý&#D걞/g4gˆrøìÇM²³!ÞØ"P¬8»+ZnM §"9P§ (1Ý¢EMöD²ªÙkI½NÄ òA„ƒ„Sà§ÜrXëˆ$ŸÿÔâIBª  ¯·|Ùã‘îu,wA#¹xŠÐÄ¡&´a6ø/ÿi‘2*rQ`¶ä°?ïÅ=…^î’ïÌÀˆ¦ã¦ÀdÃÔÂÍàІº0éL–Ŏ૬Íé0$8¯-÷¥E:åtËš’È»r€ÉQ`60MÈ5¡§eÅ^m?‘‘ÔP~«ª€ Á%Ô»+ò*Ò• ÚŠ8œeˆo]‡[¼õ­ ™ÙVpí3H­W$·¥RU¸ÿ­‚ Ó+;$ú¼×¶·?U¹‰FP‹ö…Vïã—G~H—˜CÞǧÈ/&BÅÃÈSbYª»™ k›Y¤즱GÊhƒ<„ïPtv\Ã% õC¤‡q]úm×'Ì »•Tí±ê\ARñC¸`?øC ·|?G†%Ÿ_­ç¡ÇvSo×"Ëà¤R›ò'ÃR,¬jüéü0;)8øŽÄ`ݘ¥m8¦*“Ù¢‘Øž˜ ZZàL,-%»ìH8ƒj@ 0‡¸ Üò\HàµF²Pž‡cìz <ØÕsZ$Ûç×$sc*+¹ž#ÃüÎI@WY¤´a5eíQý0$…a3ºf4 Eðød¸ZÉ®HûÝN[ÃqCÐkRhIúHÀ#ܶO5•YTž5m·ë’¦7IŽ¹yn“ÇñúÇP‘_‰O%j N1ՙ歧k÷ÖWÒBñ7Ã, º:Ö¥X}ðK#’c÷§Ñy÷S´º¼{_N!p‹*¢ü+ÆŒ Óß|¯Á«gˆAºDèÞe‰îRPLÓ¨Þ,`û" `8©ôEjZ扨ÚÛŽ85 c•Dª åUíý¼Œc YN©ÚÄZd6é5¥ä/,ªì Pé+MGí¥Å„{©Çg[ßiQ½”w:fŸul´[’y+¸Ù™þ¯ìä÷– W@›Íeùc¨]}jÎÎh-$CiÅJÉš³røxÿ6TAͲ y1é¬|ˆÐJVæö ã&‘Ñ$,EH Pm–‰äa(@uKWF±•=HuÌE*kAÅÅTþ!–œ„5‚‚ŸO¹™j²oLºËÊ•¥r^ )1CHuhhG†JÃ[BN$áŠJe ëÚ^¡õ©ì#ÔUãÅ•+Ô1ãÖ”ÈH9 Fz}©þbk¼¡f>„ -èˆ+öAADe\ `wr|}¨zRKÍvîæ1—€éAÆ„õÙrØᦩfV³ÐQ»X-/íåvb11»mË£Ó·Ã× §\½”5Ÿ.j:YCrŸº+! ¦¤ŠTá†ä™a#¢ZðM‡da= i–X-wJT­v©âÅkìµË1ÆäñŽoÿÖâ(6Ú¡¨6=Fm!""ê+ý?Ï 6˜ÅÜ€5þSQá„$Š^ÕpI±øŽ*Z%¤ï¿o™.&1÷_¿“"W=Æçý¬IP-¾K_„RµxW#kA¾D÷ÜR˜Òñ5O×%}ÌNÃuÒl>…ø.ù² 9-ò­7ÞŸNH âÇ!&Ü7ÜôÜŠâb¼{¸QáÐøŒV‰wR;÷ ì»’šx{à èêŽMvï„¢+ymOs¶ M/¨¥|: ŽìÀh0ëò d€cmTíí¹Ã³׫]‡ñÀdÊ àŒ»7ÆX”í¾ø”ÈW%>Ý|y(¢­ ‹Ìú•"„cÐ`NÖº4jǨ}’;Û’ÔJš÷Å‘Ë‘£©Ñ«Ó)"Š ˜¬f7íÓéÈÒvæ¥Ï¥Nç¿á– 4˜Úè®Z#ÉZBGÑØà"ÖáL-.4–‰¾´n#¸ žQ+¾ê(Hëß+#¹°|U`ž)Ìv±#\ú‡“#žðS°5§¾]Š@¢ðjº’«ö4¡; ²ÚéLÚÌ92Š…¡?NHH1!M¾N¤`«d ÂwÜ|ð ‡Ǩ~Äž+¶þN ¤˜ƒÉÄV»$mñä»–†ûÓzbšïu6§j`¢“0Ñ$‘jÔžõEe VSý1 H¤Dº‚J 1*OÓD€†¢¢ oMº`°Ršô¿˜17\'ÂÈW`vöð¨‘RA§Èè’„T dZ8ë¹ ·nØÑGô¸ÚÛHLvò‰¿?‚ª©ßÛ—’i.e |CµhFHäñ©¸4ÿ'·Ó„Säµ”…&•ò%–ëíP|=ñ>kÍnìx¿˜È˜„ßE…õÞ2;²æ¦ë@wÜŸ¼7iåÉMÀQ¾û÷ÁLŒ”˜uûÅGlƒîR`j|OiTÛ¯N½1á)â n*7 o\†É6¦@¯§¹0þ%$ KÅHd¨èi’‰h5GÿN½0ƒjBàM({õÂJÑlV£mŽõÉð•è[—ѹÃkº¢9¨ÂÁT½MÏS„ R@TW¨÷ì2l@U¤„Šï‚ÒGšþ‡À{丘˜Ò·¨I&µÞ˜i‰'’ñJP·JûbÊ[+óR#? G·Ç$iˆ²¾â_QÚ‚Šä1#Û"˜ž®Šp¬ì O?";á,}È‹]VòÜBC ë‹õ`10‘_§ÝtI}9ÀS‘ä>ì5É—Û{ˆ>«2’pät*ÍQ·b xƒ\(’‚Á£ŸáuSñrP(øRd:&¶6ñ]¬B[u$%›cñĵiÖ¿³‘’c°kPÐ-xÖ2ÑI'ÀÇ–ÄnÁ‡cC‘I‹A®Š:Iõ€Ì&*9F¡w£}ÆOŒ° (É¥¨gú½äS¢ò+NHÌ•øH÷Â&¦ rS}#TÅ)¶vŠjˆ¤Eä SB6÷Â'»- âX\G‡fOÏ|<@¤D†â»–6R®v5âÄ°ÛçI‘_.¡q!ˆ*X•QÑ|E;ˆˆ”›žâÞB8V"T‚iÊ«Û,Çõ ,}Áÿ×âñ ¯!Ö»æÖÖî KÄj@߉'aàL°ö2ïp]†"J/ÐBIb 9^Í¢ÖÊQ~·íß&í»q’’‚POCÇÛß ²Œ’ÒÑ¢’xĉÞ.T5 5Áº ¦ÿE±þñA”+þU;äL’òÛÎzÅ_OÓ$’ÜZáé{V¦ß,„³Æ,†z2Ûoùǯ5M7Ô´èêiÄ»’´áöiËÀe¶<’ Sò‹ÍÖW iH./K‘’HæEãPÉ Qˆ`2qÕŬâJìüƒç›—¶M*h$‡ª×cêè†CDäòq·a–KQÕaŒž›«ß~]y–Æ–ìZÄ#ä{”S!M˜G_´ßä×#L æ“ŠC˜c†ÖeUfZ‡åÇÕO"‡Ç.⧄óRe!ˆ`C¸5¾ù-ØÜVTWs÷a‘5È;•8Ôìpˆ¢Gàâv ;€6Ç’y¸Ší±5ÁÄÈÃfÉø~›Ôý8±¦Š–¨§Ó€wlö—§‡ˆÂêÀßFÆÃßÇ"C(ËeÕ`7œ'u§qÛ¯za ‹µÑпyöÈ–[+È n§jmŒl¬½+éTlv?ÇÆK#Ï›¹Þ»W%µ5î¨X–äÆ£Û"<™]sY!¡#µ+Ož"Ôµçzìp–1 «C¹©ïòí€ l;.÷íâ11cÅ]]ëHAßo}ñá2²¨—S%TØaí‘á–ás]ú•2XïÏÄôþ@dd)I¤´Q†‹Y¡É±.ê(ùXÕ1® >GÀãvÙÃÍp"„þ)I ¢ŠY}BˆdTå*+E¯SNƒ£~n Èl §Óד.…»©¯…;S$K‡‘;·',HiŽÇjx|G6FÈr–å»Fà ‹.…p’@j*ßß#Í–ËŒ’,N椑޾88C."´7CÐ%íÀmZõé_Ç1ïDzC‘ Ö‹úðR9•’ Õâ{v>ÑeKWÔ<‚ñS’øñÂC-é¦éèr ¥xfO Jõ4£ Ôšã&ÛkIVVD Hr¬ ªí¸Á·{ Or £ˆ—ej›§ A ¯§Æ›†û^ öÁ»$?ÔvÃV¢á_µAþc $Ì)²³ÛÀü°p£ŠÛ3Ô®ì7:ŒÞÙ^hiÐ×fÚ¾çÛ J‘ë_ÃÇ°¯SÜŠóÛ Ø ©ºÐÜt8)mA—¿r:|ñI6¦Tr¨ú+‰zÆK íí‘!”J›(؃"3Éctñ ë€…°Ÿ~Æ‹+pr£Àxb¼4¼1$ÔÔ÷¯|(n7¡ùŒ*l*«|¶öß 1¥PƒðɆ¹ÕTöØ›o$…ÕèH¥|rQc%Pç }ûaÙª¤‘N篈ÉÇnªË"µß¿êÁ{®Õ°^6²VV…n¼u¨;{õÆ»×Ü»’*wüjq„X­×•m\'ÍxEXlA½ ý]±c›Ä j¤ Áìr$[dM+äžç”„s•ªõ^L7'ˆWÍV)äˆ4(We" zž1«A Èf×Òá•î´å…ЖQ¢3Ø/‚|£Â=íü`ôPý4“ÕØ*¼Q–GSB¥½OPÁ°Œd1$^Êg[›Oœ—bÅäèÁëñ&Çm«„BÔÊWWîíÜŽSIQÇârØ iœ¯tmž¯¨éö×–qNP)¥†J×â#Àÿ”2€“(K…A<Ãw; ¼NÈ)I5Œìcùo\<rAÈor„–’'Õå†5ª& 9ïâ|0ð•â%°Ò£Œ—.·Ñè T‚hG\}Áœa[”pÇ#(%kW<@n„W'©eÿÐâpú²ÄÒ¢³Gˇ ]†Ù·ã˜c"*²ÛÝCé´Ð¼K&ñR¡‡ù$ðqÅcÅÜÈ4ÿ ù†ìÖCkc‰. ×—Ĭ’¨©f;‡íe2ÔD9ÓÊ]mOÊ>_Ñ¥x[PíÄJŒðØÊ#R[z-A}¼r‘¨âL±¢ôÏËý ëJKÍOQ]úêâKk&Y®®&’0 á(¯ ›µ$ †˜iÅ·åW”^9µ;ýRïGÒª"HîÄkr@ þ˜©^rr |Yª—s1§ì¢Ûò÷ÉBÖÁ­-n5; ÿ¼{æhϦ7æ"?óVRsÌ–ß·Ì?—^WÕ…½½Œ#F† 9ÊlÔs€³–j®1Ï!Ïv2 ّÙëSé6ö6W“\ÃÍ£ÊÜøñ—¯¸¦RE›m'£§½Ô5«ÙtÛµ‘-¦á,P²Ñ\lÅÕ†çù?kA Ú^œ“é\Cõ™õkŸêŒÈ}H.™*ËN-ý• Ý—KêĤóÿælWÖ‘ßéÉjó”Žd’#'ªEG# òoƒ>Kö2ÁŠ=í|~HÍ+ói-–M#ÎYê’7«3L€@²3úee_KÔÙz`8Ï8²âاߠüƒæ= Ii§¦…ι[„…#1‰I¸¢±wø°qÈÐq Ùä¾xò~‹¥ë­cywWw ×qßq±¸¢€5Æ¿eâÊNáÆž06<Ø,z&¢Åà‘l!—иÔ7–%r9)!aÌṯ–Úxi"8vGFWB#)VòØ–¹µc ß±L˜Âïp[2SVØÕzaEÛ@’H;n|wÉ°pé×ÆžÞù ·¥à×qZÃ%H½Ü¾-úñ¢‹áP(w4§ðÀIT·ãë(5 zà%& óFËîKuŽG‰•Q¯A6"U°L¬¼¹æ J‰g¦ÝN”b`¦¿å.CŒ|$ôCßé·:lëivž•Ë¢ «°*iCÄš# )0¯$¾‹ñ ÃW‹{S­~G,âjà6™hÞ_Öu©= &Ê{ç‹,[‰?ÌGÂ>ü®s™g ù3'òÎW©ÕžßF€õõ\K-=£OøØæ<µp £O"É[òkÈÖP½Ôo¯›˜ÌP+Óù~Ñ5ÌÍÈ›-\Ø`Ò?//­§6Ðj:tÑ\z ÕÂÕ¨cû^Ù2d |ÏUš¿’¼Ÿ ǧù¶šyLqèBÑAZ´ÑòP;rãö°Ç9½ÂN-¶)y/\–IVÐEzb‘a) «Í¤qUÁž¿äå¾8i8¤”Üé÷ð/©sm,1óh¹º2¯4b¬¡ˆ¡e#|²2 t )Õz‘µ:{äîÑ©SPoýr&!‘%¸Ø© G*šâBD•­¤’>k,¥†•ä$E]‘ÒÛ׎PÈS;Šm‚Ç&@J¬(Ëq3L] âTýBÐðð±â!¦¹•šÙËƪVßb»aG<•Q’xmíçnK@qã’F0ݦ›¥ÝN€_„§6‘“uè+P;à2O(´Ò4讄/¬EÀ “×…ÝÔý𠇹N=ú!ÿDh¬¨¿]y¦vôøDŠØ§“}MiBL6‹î¡ë_ŸË%á=îIû;’j…11b *¯&ŽF& šÓß~™C8ÄŸsÔ¾«bK‚†µû'°ÃJ)a‘ØšlEqÙ%ÒHÍ¿q½;}Ä"D´Xß}Pzuß&h±âïi&•I<º‘Èxƒ‘4¢šÖv P6öí’ØÝ4€×¹~ìHd$ NäëPzžÆ™NÍ+…Z׿Oד£h„è¿ÿÑ-òï—o‡×æÕõ 3I˜·§§é±ˆ½9¥ ÍÔñkÀ×,É1[nãb‰ÞÓ}Oò“Zó©q.¡ªiö:u¡’M4‰¸ÇBË $*sø™²¸ådqHóCÚySË·Ö¶¾p¼ŽäC Mn4væn]ÀôçA%ÖŸgr€Iõ= @ò£=½®£q ­­ô=Õ•Üpó@ªO1IU§§ÆªßRfÜGšóKÐü¬R[g»¾y˜Ú<‰$ÛqŒû¸Å_ùr@’×´RmCÌv‹v²\èðKqÄ.㤒'~+ è:×& {ØñD[ß0³Æ­3›kv ˆÈ+2™~5û<»b"Yö¡Ë÷¶°\û‰~U¬FB„‚̾5Ág¹&#½—¾[´Uk`r4&Œ$ Ô2Ÿ‹Çrßš'Eó”5 ý =P´Ã‘âceSÄžGߢGFQ£Õ’YëZtÿ¢ê_ 9¯¤´$†£éß+¢’;ú—¦Ž9Íœoªj6 ˆ`GhÝÔ€Èì:€w¡ÄEŒŠE¨iku½­Æ‡!Õ®.-îo¯^Žeš‰Y•IEæ‰Ä0ɉÕ‰„{’ëo(kÙjCKÓN£²G ¦©)IÔ E–2¬¿ò\Vwfn˜&£ k6zn© y^–7†Âé$–ÙeŠ¢UŒÊ)ÂDø¾ßÈŒ¨XhHÿÅ'ZwåÔú~e®ùSÌvòê3°šëF¸bËÒzPQTþÇ*7,8'p“Šqå»ó'ågœ´›«‰Ü\Í­,jíEë[ÈŒÄpŠPM{#ŒºÇÁ¢P ù¤þ^ü¼×¼Ïgéùq#¼¾¶å-ý¬Œ ž&4|\€ÊeË0¥l]1ëÝ+V°¼Ú†qo2£+}£Ðl Šå‘É}vkØòYõ9­¦’ûiFʲ2nT±ØoASï’2î@óS¼‚H Qˆe~\Ð’ä¥kCî"fÔ“H¼æ—³‚÷ôMصºA%¼Æ#ÅÔÐTåßž!çÉ'åמâ4}õ8îÄÄz}øN¢=ìN)w$óézœJ'³ž7…¸KÊ'¨6É €õPszf‘©ê·ßN·’æC±*ݘü*?Ö8LÀc™ßyfM,Fú…¬åÙ ¬§”2š0$R5ÿ‚ÊNkÙ¿ÃêJwåñ䛕úµí­ÛÏ%BHªÛÄ”Eâ*I')É)Û!Ž2L±ò½´—Pi¶éûŶ˜y&àœsWô½Uû)üÙTr¶Éc˜áÔ5HÓU–+¹$/42;”–«éÓÀ9o½Ã_­˜n·¢^Ø]Ò˸­ìl$B nIëÞ¿Í™ òh69¡­^ä3QmÛÔ‡÷s¹¥f¿ ¯÷¾<ÇʼnŽÌ¯ÉŸiß™¾qѼ ,tÛÈ­M´Þ¡hU•_v,²zÇ–˜Hî[FnÉ~Ÿù±{«Úͦk7*«,`Iy?"¯Ãì§îþ8Ùÿi—+–—‡“`Ô -©Þ\ÜߢiæE6ÈÌ­o<“Ī율ȿäåØâ:´Îrè•]j·®ÿ^»gw"”Ôt5ñÛ/«ŠÛX "2Çœ¡kV=hw;å¼!¯‰´†Xà2#»RA(Ÿù]~Îÿ, xû“;m{\¶º·¹·½3}UÌðÅp=h¢,7aÕ? ¦X£îr#•–XÞÚ]\ÌÚö“¦L’´oqw鋯ÂWP¼iñq\¢WE¸T¹„Mÿ”<‰s|‘i÷@ePÞ…¼‹=> ÷¼I¯‡,„sϪËob–Þ~Ry£Õ1i¦-DgXƒzSѪ˜Þ•u q98êcÕŒ°Ë¢Z<æˆí¾»¨C“oÌD¯*ÁV=(¦­ÛÃ,9ãÑ„a2‡_*êÒÐÚµ(]Œ‚jØò ŒÑS uDÚù7ͳ["Ò®JŠU îvaV ÉxÁ¯Ã'’†¥äÏ3é¿^Ôì ½º•ŒH^6‰Ø|,ÇðÃñ&­'‡0‘´3l½@ùh®Œ *M^ÄÐá`by¹Ë4´ÜvÅA\ï@i°¡ùò4l…”ìvùxd¶¦…ÁOÄNþÿ<¤€àHü)‰ˆÎ•5T Èr4íËz&Ê°ÜSq•h¡‡òš~ý±Œ€åjÞ°ˆ³ 8·pH©¦+bcJŸ¦uFbk©j~<€tÈœq—ŠNÖµµ±Æâ9RQñó@Iø¹}®£| ZìªOzÑz¡cŠ5‘F8 P)°ñ9ã¢Ù)’¥»ÈHhÁhh:Š ï‰4Â!ñ1ØÕ§Ó„H/ îZ*’קÜ|±(Ñ×:k¬)}oûËyŽ¡©º¶V%Ñ°ƒÍ-1«ÈÜŠª ýY*!@óVMUtw’ž¬Ä¡êwÈ™2¹+8š5:>c¯L”J Tˆ#|NìFÊeMj; ÏËÀ±”1Û¯†F©yík ‘ÔtÅy)cQô\‰d •XÓµ I L7¯o|‰fXãznk5JlNë¾A¡^˜òBàÕˆ*b½X{äƒKƒS$)6UCÐS UB ŠíòÃe*+ýqcºcg¨¦nª í¶JÚì£ÕD‹ÉGt÷È™S:µse ÄUId=iŒfƒä¸A8š×¦LKtPæ°8®X#mfT¨[­6L‰°»pmè6vcÅ'QOÚï]¶ÁÕ•Šhè*=ýý°°7Ð7_ˆôè? GšH=Y§N'˜(,Esmœ¶õ©;ýç|vee¤b>Ÿ4À•yæi8†ø˜(Bá•€m¶ uRTßÀ•2HÙSêŒx‚hIïÆØ‚« $N¬à1×ƃ¥2$¶mÜÜ£MpÄsŒÔQH¯Qñ~8ƒ ¤jMdƦ/ˆl§~•é–Æ]íD÷ÿÒ“y;Éÿ“ž`¼·Ôb†M?UWX†w*S¢Q8ÕƒŠµÊŽiÀ`Ã+óå•u«gpòéÈHòÚõYTýŠ‘²µ~*d!”ÑFXšœ™Iõ44ìdpXݯŒÄó@Ãæ½~ïqnD^ŸÃ"qE´e’.:y†Þ4†+é:òERhI>#àD§Æ!4Òÿ1|ñ¥Ýý#'¬è¨ È„SÈ ö¦ùQÓD³ü̹ìžÇù»æ›M¯ÜÁ$Ár¯9%H«Ðý¬”zc©=C*ƒósM½‡O°ó {¸X*­½ˆ/E Í(~ŽÙAÀAÙ³Ž%&ŸÉža†æ-GÊÖ•í¢ åv„^.Dîô¢ðl6ň$rÜ'šoçæ0Ó$-c5ë†V6rÛÊË(–ŽT£¯;9YÀ:G5ó ÓA»ÿh)¨kZi‹,rÜ\ )s5²ülÇÓ+'P?¼ýœ®B{ =)„þ—Óô-E-?Fêbéµ ÙÙ´Ù(êÉûÃêQ¨Bû?åa®ôG–È?7Ê.’]2mVÒëSóÜ6Ú…¯¦¨mf€´ŠÞ¢‚œ$fø&?͇c’\Ò‹3ÜYj7jÖÒiw?WšÔó¶”7R$Àpñš³åµÜ¶9LsÏwÖï/-á·½y“Hµ[FžÁ%ŽOµÈ)ãñø,·Õ«.NäÒÛÏËhâúY¤š¨ër-Æ%6ÿih>,Ä/f^(«(ÍSóUÓm¤¼Ó¥«Ü¬bÈgôŠ·_ô›bdU¯†áÒË/s°×¼Á;”³`ñ^È×7“Ø©„$ßi‡D?ìœxeÒóTrQèÎ.u=/Pòõœ— ¶“Í ‘¬¦çÓªKG¸ç²|cù×1½q-òb y>Ú=Ã[ÜD=e¨cdH]~ jÛ«|9q™#p×ÀÒPú”ñë‹°â솤.cS$5F G öYW®NGf3³¹uì¶RÍÕm-̆â”ø‡Ç@´)Jå¬ù!¨=ô×3@Ó}eŒÄFHF#`ʽ¹ ¶1êÖgÑ£Ø\ÝêC©ž)¤A$>(­ñoÛl».'£jŸ–UŽîk 0ofX¹à7<ïñÿ)Ê!¨³EœñPÙçZ`æ¡ÂAýâ° Š”9–7hâ †ƒÓµ¹K™!umäŒñä„‚Q‡òšo‘ž=™BböGk°éúŸ˜šK‚8Y«´aØ)fñ‘›*dzœ®[(k¶ém¤]$ $F<ÈäÖJÉÀ¡5®920ŽË?MÙC¤‹x-EfšéäI zE$ZÖ:lÇŒÉ检H}W{îÑ¡V–{g· À1Pßj¼¼PöÈÈôÄŠäžipkZÎŽ“\ê0ÃojR [v%§N¤«ôcör2"'fqCÉ=OË_P±ý%¦jz}Ì„ˆ;Iõs†BBÈ\qVäGòƒ˜EŸ†yÓ#Ô¼ïæ] -^ïFM*þIRò}UX\ -®c‘×vUIBþÏòåG"Ü'Cp”ë~h‡[Õ-µ_0ÛGú"ÖI?GÄõD¸“Òø9¯Z+oÓâÉÃÛ› äçÉoù‰§Zè–qYXØG$ÒÇòF­´ø½Ä |9¹A”@NµnÓ\Ó™ìîÖIøárJ‚HSFÜdH;³±[0Kqhou9LìC¬®j¼”Ô0Sµ|s*5Ð8ò$ìKŸËZÍ´¯5» ´¡%ÐW©ðË„ DI*¸•Â…t¨„‚‡(ßFNDà:9ÂqØŠÑHñøŽã, DRÒãr ׇñÀìÈÛfÛá$ ü%@«½{“\M ´òÚ•>'l ¸‹¡ÍFÌ´;}Øm«‡"8Š>#J‘°À¼@"íÚ’5¸ƒàçÉ؆Ý[±ÈÓ B`5;EH‘tÛN(Ä‘±‘ÈòÜ'¡I#¨FYù€«Â‘ùrÆg®ËõyȬ)â|>ef½c :#ÿK_;Gq“¢X”:Ö;yBÇŽõ~2òmño¢€òž³yõy´Iìîn‡4b¢TŒþóŠµuñÁÆ#Õ$žMÜþZÞG+ /­áà#‘«1'§Â6?ìNHjbŸCšQum¥éLñ²ÞOp•.}kãµIÉ rb@ŸÌÚ¼E,äú›™!T{·\L/šE Å$Y¹‘Ùžâ@ì&gcZŠ×$1Ä'Ä% 2„căZüXHˆZ—Mº„6Ç­)á‘ᤂљBºÑúÔ{ôÃ+Pz~šÚ„†;yc2^xžÙ4Æ#â‹>XÔw+éHGP®DÌ$YBÍ¡êq£;ZIÇ¡`¤mÆ}ñµ N 5'çï‘;2XÊxïÜõ9’$VŠo^˜–M‰é(-Ž Ý1ÝW­Ƕcv¨Œ§ã’æ‚©Ë¿¿L! €…çÓ¶JÔ„ßN––n‚›V¸$ĈImHZ„Œ|«€žõ W¶šH!ŽG#žÁIðð8Nëd)ÞpÎj±ÉÇdhTãZW·†Mª CáüpnSq ÔŸð9.Ä»¨©¯–! ž ÐÓ$k›Iqè ê?¦ I‰hÒ€ô¿lwIpm…)Ôø`«^>”¾1Í•V€– '¦;®Ý¤níUZÔb{Sé#}”Ä¥FÝŽÿ*a¥•¦NCÅË,¡YMk_m»ä cî@2Ìõp;šÖ½0ŠN䶘qmÈÜmÔ×µO„Ä&´þÌ”È ìÿÓ7òòMŽ­¤yŸëÄ›&ºÓÄrHï0b߸ ¯Éc¨O·•NDŠD`!¸)ï˜ÿ5ü¶šœz^¥tígªGëÁ¨ÚFñ¬ïð„pÿMÌ|_g,®8å͈á&‰wšnÍ•Ìf©núœ­qonò!vDíâ¿dä¡ÍgDw¼ÛÍjÔý7¼E1=¼wKfT>±”0î§ù3+;œiÎù± 5]>Öç²IõбÜ?«Ë›Ð³·ºlWþ2€‘ê×qV“ÍÖÑOnöH¾’Ñ( |Cr+^ø|;AÉÀVjžhŠøª@Æ ‘–¤’kïŒqW5–KÜ+išÆ“¥I=ÍÓÉs)ù5]KT†éxšÃÔHckeˆ †âF*7ÁâlÄÚÌZžŸm¥Éå/évñè—P-ÍÔ–mõ©hŠ z¿µOSìSörQ‰&ʈ;Æ4_0+Øù’?0é¢ökõ,ã‘ŠºHª­ëÁÓørs…ò+Ð7l’/6kž{ò¶£ ,¿§uX§k½½ˆÛ²4d’M9¨ø˜åF2¶ÓêšÖÓGÓüÝ0K¸ô¥¿ŠÑ-…«Å:gäXŽ²÷?g-2$wµF4Yf¯å?6y‚ÔÙƑݤ"7I¢1Ä¡ŸicŒ©ôæ .œÕʱÌË$IÙã^}òÝÎ¬Ï Ê\[ÖÜ!Œ4øû-Äÿ)ÍŽ,‚N…lƒòòÍo,7*XÂ’Šxp:r;Wq“™ €gÑê~wÓ§~Ÿ`¯s³ÎÆvøÅ!ß‹Wìÿ“˜Æ1=[¬ŽAŠ+_ó-‚ÞA¥[Åq€³Ä}9&ûLÄÆO§µðäÀæX"Àe^Tü½óŒHd½Õ¬<¹mx†KZtãq)!š6E<‚í¿òårÁ¾w0ÿ9yGÌúÄÖú´aãFà/-Ï©lÅÇ5UqþIÌŒYäãÌjLx£¡õÑÕ\•R7ߘ©>qé—‰†¤óËWz¥¨›R³aDÁ'¹‘IHËl+dzdrSbžù~ÇVÕ¥¿º³¿7W qé7 ½(Q(J²z›2ÔýŠòþ\Æ— [ãÄz§3iº¼qªy–(®,ÀàÓùSo~%lDÇ8”xdýJòûKÔîdJ¾y}%RÐÊ©H*¢ª~5¦Oó$scù{äį-l¼½¬¼Rˆ®¤µ1 ñF\ €ßꟴ2ᛈlÔ0T·AëžgM^Î8ÍŒPIÑOj„­xq=²¸Äƒ»dÍòJ’tXèܤöxñ§ß“ ô@ óæ¬f79H4ÌÂÃÖ4½VÕ¬ev~\I^#Çèñ̈y´Kˆ1 –sýä$ÕøËn+ó®]³P(Í;RÔ­íä·Dõ-e!ÜzaÊô ÊÄ6ÊÈm±Þ›zþV’â8ä3GiæŠ '“–íΤ e;&D™Œ"”LÐ+Õ *Ęù 5;Wß' c òX2UXñæÔ.Æ€@®Þ.$p÷2–òþƒ§Oéj:“Ü9çÌØ…¢ˆŠ¯¸ªsY@Ú1¥1Õ$Òt•ŽMM†KY¦k¬ßñ¸•Û‡*©ÙT¾Ë‘2æYJ;€”Øy–xùÉu ´ÑD©0Ä¡P°¸…øÏòå’,Aï SÕìb´’çêÈ%Ôìää`¢b™¦Ã‰ì2  ¶˜ŽlsNó¤.£°špË' {ng’GI oÖ‘üY#«_Jdš­•£y·WõV’$0º˜‚ƈ£"Œñgû9#\™pÙWÕ4ûytû™æ{ ¡n¬Ò’‚Ù]è8ŠWˆ`r o».*ª¾tóÆ…<Í ¥c½œÈѺzˆÈ„RhªÜq8"z¬s–Ýþcy¶ï÷—o–!džƟËþVHiGzË7’V¾rÔÃ.f†IŒ±¬µjó$PW¯\ŸåâŒä«:$·?éŠbÔ”VBjy7Ä+J³ƒÁ#’@JA«XÙΉ}méRRË4)]¨ÔFU;üUé–BG‘kœz„ž},å#pÉöþi¿|¾ƒW!Æ‘=±€)ñ5vÿ ¬Ð;³¾Mùtô»p«lܘ?!Ê©ÔÖ¸Xò¶QçH˜¬Ìjêìò¸©iB (wÂ’7µXÆX¡*ã¾ø%%)ÎœeŠúôpš;2Ÿˆ­hi”È_&È’‰Ô<ۨʎ–ò#BDÚ«ãóÛ|RÙâ÷1«Û¹®¤˜òrI-JnÚÉpÓ2„$PP}8 e5„ŠÐc£‡u7|;`foQL KH8¨hŽýÎ)w.ãçˆUêÄ 2V‚ª®)ï†ØÒõjϾL%er"jŸ°Âýq!‰ €‹“3Á%+½Ý‘¥\ ˜ï#PÙ QE©ç¢ðÔþ¬4š“A^߆L’ªv©-ØU*¿_ë€ILJàI _ᆊ‰E²AAP{w®Y‘ƒH¼Bþ²©NL=ü>UÄÈ0$¡ä·q$Ȫ^$mÜ ¶Ù‘HÖòî¤-ëÑ>‹nuñzœr¼Bé —y*3ÃÈ‘Wp6ØTïã“â )|Uüz¨…£ Àû55ÈU%²ÒÇ-ËU/ÂŒNÔZSƘ‰ŒÌ îxd”}Z/EJ×znkŒlóRÕ!¹§öo“¤ß›k;ƒZî kúðSD½•eY "jPä¡RI4ÿÿÔ"ѼÁg¤éº~Ÿ£kÛùŠæI#¼Óî[ÓH ª=v§Èý’?Ùd¸ « <…D¥¿àÍ[ÝcŠFÕ㘳þ˜‡¢¾óDÎwNcö_,âÇîk©ŽbÕ/üµæˆom¼Å¥O¤²OCrFòHBL}©Gø† Äl™HÝÒŸæ=§œ…Ï¡qk´‡×ŽÖzJ°ÅEŒÑkXø’Ä#ÞÕ”w F=G\„3ÜÁhŸ #ÂøÇ î*í™&½¨OÉKN’îÇŒÑ@%F¬`M|2GQ2Étï5òfú×—"h­@I®bZp'ö›m²™bêÛÀ¬yòÓ^[Éú>!qJª@Sµ7@ñȘIá)î§æKKí:F¶·¶[, ,j5<0B$Ñ>[SÍ®¬"·‘\Çé9Œ6õ}­üs6'g ŠMÅá,Ä|NhOPA8+¹¶ú&š œóÊ°Ë'£¥xzE\ynËÊö:†§*Çu8Hßä T ûj6n˜ øŠ4¶?™5 øZv‚ÇS³Y`•ã*  ‘Šl‰!<›öòÎ.ÉquMõ¿:C¢é©o¦q€Z‰-âôÈU(¤*ga]þ,€Âfm‘Ê"{æï;ßëñÆg,°ªŠònLÍJ·~Y•N"wjž^!³[ñõ•ž6q@ˆŠÐm¿Ï/ Z<ù#ôŸ;ù‹J·¹²õVêÊíJ\Ù]¨ž2‘ά¶Ì”d îm†A]éæ›ç«[Z’ÚA %Ò2Oyf$rˆ^R#2#qÞ5ʧ€ÞΉ;l˜Xþ[ù¶;¸ÚK)nôg•f{ˆP³<]bs=DI)·%È™ŠóH‰~OQòœ,£eÒR7–Îß,‰! ¬ ÅÃ_ì³$O7*$™N±ç?NÚ{=Fu 4·ghfDœsæZ¼T©?B ôc(¬;Yò'å済º£'—înZÎT-fŽOÄ1ɪiû Ç2!šQæШiþN×í=kÍZ6Ôá¼Ò¶Õlˆ–CöEøf‰¾/Ú\e˜L†3Õù‹T·°µ– ¾¢ñ¤j–±èCC£mñ¯ìäáêa)pì–ùwË:D†âêú9/µ “Ãb’ªÂÑÊ¿²¯Z¯\žIŽA8àyÚKæß9kžfAiqn–ðé²7©,`òàÇŠ¤Œ>⣄uø²x±îÃ$ø¶c×|iõD¸õcáVš3Ub/„S-aåhKk»Ëu"Þf@ä3ªŸ…¶î:7Ó‚BÙDS.OÌIÿDI¤Á¥Ø[ÅrÀ»G*Æ›ïÞ£)8Ï{.8×$÷ÉúÞ³­ë·V³´6´Â‰ˆLžšví‘”@‘e~†óG—¡’øÈ"¸µ¹ú•Ú$¨Î¯Ä9¨5¥Vªr|Q“ âƯZîk™æ3´Œn&ØŸ¶Iä}‰9x 6i³h ?†HÚFê‹,Ä‘¶àxû ADOr*_L¢/rK?4*:äL‹":ò_—#–7“Ìé¥éÚt¶òËjÍÅ® é^Lj£—ò¶båɾÜÛ±Àž´eÿæ’¬‰¢[ǧXÍm-ÃÛÂÇ‘šGZzŒÛ±X*åPÇ)sm&1äó5ùÂmQ’pÑD¥}P³×¨>=37q2d¶0ìj:Ö½~Œ¼5´_zš×Mì¹Z¢ÏÈSoÞha»²cmÍZÚYÝ%”qÙ¾Ôbž^HÙ Kë÷qLb¹rñš˜äRñ'¡ñ¦Å2=í)µ™ÕUúT¡ø²Ñ>|)힉=­ºÍ¦HéÁŽ&,[‘¯V)Ê&AæÛB:O&Ûë:u¼ñ\Ãa¯81Og"˜’IƒSÒb+IØq`iÁ²®:;³8ö±Í"»ò?˜¢±[á\F’5¼‘Å"´ÑÈŒT£E^}º¨Ëc”]5œf­+šX£EIlý¤Tüc`yWíR§²‹!½Vã+`dØš×cØœ•©´ÓMÕ"U±·½OZÆÚ_UâSÁ˜š)%†ÿdd$;™Ã–êW¬üÞÈŒ‡ê‘RP>ËQíß•,€#dÿB¶ÓïeÓíç’öòÞ(æŠæ;h]ý! ähí}¯ò°NTSñºmgäØMõ„‹g©Ý½´)5ÒZÚÈÔ%šœx_ƒ’ýœ‡²ø`®÷FÕ GÔZ»g{©#»C r*ÔJîSPx²áïY5] +«]&öÂxdW»™-m%UCÊêAˆ洒"¬¸ÎV°hÙ­5OÕ/Õ¤Ž™bœZÚˆëCAPà ìÄìÚÔÞ ¹,ör1;‚µßß/ñ6i0õ#î|µ$—‰Š –X–Q *h¤îFý¼1¨YYb½‚·˜<£sa+Á3‰HLÐ2Ñ“áZ¶ãÃ"3‰rdpóc ñ@d0µYJˆ¤æsèªÊ¥ž1Ä•4§Æ½rrÆ9¦3¶O}æý+\¶U¸u¿i(&P²Õ˜Ë]¾ÞF1!¥gÊvº¶¡*èRKjX伊PaÄÇ1õToE‘²Fd ؘ‰½ù/ùƒ¥}al#]nÎN q6œþ£lIC$'÷€Ö¹d3Ĵ˃Ϥ²½‰¸²KFÄ:²Tô5ðé™vÀS!Óî|·¨ÛiÖW¶ÑZÍhÒG-ìNÊóÄà”ðƒû-ûY"Dby2Ù¿-Ò£íšÊêÞb ñš9HÌHÿvy(µå”A¾l¼%K/Ê_5Eæ›htù!²ž+hõ?®\L«õtVÈx’zŸ‡l4HܤB\Tß¼³äËËöú­½­ýâz²^jL€ú²;·¨åÚO‹Žù‚r›Ø·pm¸Ýþj[y Ë~OÔl}+m&ûU¶kk7‚yX© Mû–cœ‰a,@çÊwÇ4²H«À9ÙOe ÛFéðŠ`°@ü@cÐ4¼09²ŽB9=ÂO/ØiÚ`ÒækoY åB ¸ãF(>*‚Ê೓m»æ”ù–úD¿Ô,.c1©¹(¢6%#h)7û_Ëq€Âr¶3{<Ž=@JÊ b8 ¾ýrðÓ)ZN⪟ é_ ²T{Öãܹ¬®CâIñ_|—“~H¤Ò‡¤ F¯aÓ ºÚû‹–Á‚pý£üpòæÆÒ⬠ÿ$Ðœ†Í»”ãA°¶¼Ô!´ºe ~DPÊM=9 ø+^Äü9 N—€’ËʶZ-ü3_*Þ0¸·ž0TÑjî­Çm,¢YllÜ FĆÖ5…·Õ†¤HauŸ^VUC\)ééòû²<Ù“§'œµ›4¥åŠ™É&yÒFBÇ "€˜Èý“‡}Qâåy?3õ^q¶dyíîãn¢9 û|{þûö÷Ä`óds Ø(IçmVþIážÙnmg™®EØ2Žj†‡ˆÛýŽ‹Í‰È/pÇþ±q5îY°RjðË›FÀxÃK@U>úpÚ vL¼¯­i–6¡a b-c¸gô“ã«’ŠG?„Ÿ†¸'åÆoŸ&E¨~jkQéËa¦ÉõxÁÚH?tN!VŸyÊF+;¹> `”ÙþeyÊ Ô®§3)`^ÆŽ;ƒã“8A ^!´úëówκ„vZdïg3’'Kz~ò¢Œ#âV¯ÙÊÆœ îÛNm¶ º›õÍ#Cúþ¤’^™Z),žxЕO¦Õ&¯ü.R"Cqá,5tÍõàÓRÖ[`üÒ}D!’ŠZ.HV¼–µç–‰-«† ÒYoäO3¥íªÁk=ÍÃÄï,+$cê²¼ò¡ãËlŸˆ4z‡ Èí?+5xµ×ƒSÓ®.,LÉl w h²ÄLŽ¬Tªkìóø*9ElÌNö“7‘—I–I.4­Jy Éõc%«4K(“Œeè>(Ú#Ë—ì2ä†bCc³{»½*ëËpÃõçÓ­âSí½²ÆÀ˜EGÂGÚÛÔÊ ÞíÑm³Íõ zßR¼™§E»áA´q#PÊyì~.̘‰5N¯t³ÌKä oWô$7VHêRkkŠƒÝ[ãüÙ8œZçÀ9Éü‰å¹Òiíon"H¡`˜FYÛö–6 x`ñˆÙ"ÉêZ³·Š)’òŒü¹F˺Óq_Œœr”a*›J‰yî#¸Œud4?ð C– Œ8ODºH8ÍHÞ»Pô93+@ FI¦í]°ˈ­6Ìëü2 âòSxˆ4ã]¿ÌäHgıÐ)ì{` TÖ1P;M¬à*GzïôdI,ŠÆ^”éL ¡L©'˜-“GjøvÅ-¥ ðñÃh(ÛXaaV#“n9¿ °‘O¢†é¡ ~JªIqt§ùY!ÞÊ#É g|¶Z„ŒÂ€lѽ$$ÒOl6E<·ÞµëÏR¬I*j”Û-ˆ Âf×\^Nê«#ÕÒ«^øh1…4‘ëÖµ¡§ödƒ ÛLM¸VŽæèÙʘd(^"àz|J?Êø²'%$G‰'—µX­âAõ« *nmˆš1_æãñ)ÿXaŽ`ÆP(8éPÓìF[ÆZ„B&Ôij(ØÑkà|NFû™$ÕußWËöv6Êki'/Pý S`GúêjÕÊ@õ[p#†‚U§Ù5Ǫé4Ïû™B®Äoþ³eÆMT~­Í»‡©Y‰*k±S¶ ‹1hgžiêä¯"{ïß%ÓJÖ»Ž!éÐûa7Õ€«ÙaŒwßjøõÄEe&‰=i×ÉÉkV€×aÓ(“jSe±SÊŸ*m’ºEªŒÎ±¨©jÓÞ€õùáÆnI#gÿÖç:Wå…¶µks'—õõ‡´A7–HK%xíêÉÅnà2óz–-´?+yRæÞkh¦¸º¼Ò4rºúAã“àôúü_cä&Gg#(­`Y‡ÒWËšíºêöÖP[ÝØGp±©œ‡Ô¨Gäh¼k•Æ6rpî©}?™5;wµ¹Ö¿E‹©K›KÈíæ³i`OQOïԧ¬8ÿ•ˆ T“!³Õ<©=¶£§G¦_ȪYÚ¹…g œ§-êe¸F»| åð˜!¦\@ ¼Û¤ùªÚM$<bîÎØýbFeguiJÜ[ã¨]¸ä¡Le"¹u§nᶜÈÃR·-Ã$ŠÈ\¼Õ‘J™”×"q÷6ø ¦l–ÇX‚Mz-Uf&ÞÖÚc/¬c‹âf@ANUÿ++5å€ú’k„Õ¦òþŸ¦"´ÓžiL[‡¤¿a]{óSÈe¯všØ1½'Ë×·Ó¼Rbxc‘b! •÷[t<ˆëð®HÌE§Ú=®‰¥±}^¯ëPÇ)m.5åP€f¬Ü¾Ìc dO% }]ù}§ØÜ=䚥ªjWY$ºrW”Vò x2-:Óì~Þ ØäÙŽˆÝ˜Ão©jÚ|÷ºÍÒXèðê Öþð¬|TÃcáE=)æÈM½\–ÆãZ¾€ {[«¾^¤ß àª@þ˜Ë¦¹¤~jómºM-кn'ÓCN % -U÷˱âòjÈhó`—>rºôïc¶fD¼nL( AíOl¿ÃÍV~ v¥®}m,+ d ÅI݇Ús_1$s^‚´Bf À²Š‚¿G¾LPd¶¬ZIQƒ‚'PíL˜Û’£ß y=)¬UØqëÓÇÑQæºõbÈB©oÝ2íµ6#%Ãl ¢¬/¬2Cþ¯Û=*QôõÈɘ(ýËS¿ˆ5­¼œabˆõ* (­*{ä%(õH¿5+èý-dÇzÌ÷P°i‚‹’A·|„¸kfq‘º{Õž¹¨ùnÞÙuI”Mv­$RÌ¡¸?¦8+Pä6]—áÍ\€'g<ì7až{ÓôègÑVM6-OÌzŠïšÆtZIC*¨T¼ÙKHÿo-Å2ãdˆÇ6<¾Móf‡êM <±FñßÙÏÅ&…QF‘·)éІåË-â‰G‡ „Óüó­éö7(²È×f㜌MP¡bÔï°âØgYÇ&Û§ºç§e;ʲ¼RHG)HM”n~ „´à¶xµÉÿ+=Rêõup½´h!ºŠ‘“$NÎ*®Üè}*ä†ÔfFEåÛÝ.ÿ@¶°ÕE…K8Öy­âúÄpó cê|rØcˆäÕ“,¤„ÞŽ:t¥|2tXªÚܼ…V`°Û¡9+BÔ˜4l üÁ¨§Ó‘dÄ·æšRÒLÌÉ$±yž[ö¨ø°Ð”“mI¶×loJ’· ¯Ä'Ó!#ã]ùÁ)Áe)¿²¿Ó"š6Jq%XPÑ…@úk–DßV¹…¿!ãÅ«J ³‰|”n¯DXÓá4â0YHn¦­v#ŽJŠŠâ•hl¸W4F­7<»d£³e¾ƒwtálÇ&èÅ=êiJ`Ȧ$ìÌõígKÔ4K{ BD¹ó=¤±Û ãð’)ɺŸ‡jþÖk÷o¥Íá±ý&ü¬Ös®©s%…¥Âé‰t Ñ‚¶í×l3œ«bÄ@Y°ôMôþ‡9×n-àÒ®nLÐÙÉD¢Ÿ `Ÿ…d¡ø—1ç`ìÛŽ"C¢Yå÷åÞ ¨À‚ÌZߘ§X¥oHÁÉŒn¡¦Å>„gcàÂ.¼·}k£]jÖ—9#•Öx6Ž‘]Ý:‘·Æ*¬¹pÊ ÀÆQ¾¬nâÅ´½xZÝL%Qé^Ž6;øeàí³¹P¾¶’ÖI!)êC'ãíˆÝ—.hTØGe+AñuÛ&"Óm‹y§V¤+ÎJvøÕ2â¶C§^ˆí­šÒÊÞª´®PHÒÉ[Ô,ßÌ_ãQ•H‘ ŸÚk:Væ-HÚZ%œâö9¢âÁ·UÿIدÛ^9\!´ÓûŸ=kiºŒÏX¬a¡/”rßä~=NUáù³SHüÀµ´ÐLºmÚÉ~’ n„lYP¿Ä£í'òär@¦["ÖuFÃPÓt; šHîVk©†È&räWí7,® i‘"«ª|‰h‘¤_â°õ‚pZT¾Â™Yð• 5 ¹I‚ܬqPúr4ăý¾_ˈé'j1ó¯˜|Ãm9ý¯»ød¶Š`Æ=·!Ðòú338žŽ6L’ŽìÆ;æ¹ õñ2y/&RHâjÏ2üqœ–OkùqgwoT×í¢¼ˆ2Ô}ZAƪUª$V¯Ãö>ÖcÏ%to„%%ÖºMö™©^^jÚH¿."æŠ}T!è ŸG ‡Š˜‹õÙ¼Ï噕låB1>¤™ZÕlìäk›W’ØJ”T£1”¢ÆCnT6Ãn›ŸÃ •¿šŒ¶÷Q¹õV›ÓÇR<ÔÏÙ,zTû "LhóR+Ê´ß¹ÁlŠ½Åš@³/>T#èÊÌ›(ÒpŠî­+ÄûŒ Zñ1©Ü·LS ma$HÜò$$=k÷b—rä)þtÆ•rÈÀìhÕÂ¥y•ˆ&¤ÔwñÃH÷¶Ö§¦•Xåe5´lˆ+’Î*GL˜`d‰ŽXøÓKw=jJé¦:î™?ÁcièK°b£aJS",”šfÞOó‘åå7‘©‚Yâ\¨f1³ ªÕOó6G, ÙqvS½/UÐ<Íe.§¬èV¯#\*Ÿ«¢0(Ä•§*Š”Ê<‹hœdM„d~JòÍÌ0I%ƒ,äŽSnä¸#ì·#¿`¦âmÿ/<¾Ö’ÞÚ_ÝD!›‚Ã?v’ýàÚ›úc”͇óîbp…2»ò—.ãÓõ[”hÔ4‘@~'Ôæ@¯ÂõøXeg<¯pÜ1Äo:ó“µ{9RD&þ+„C< ·¨½ÍòÒ™“(qòB’+'Q‚:ÜZO Ì#uøzWqÓ/îk|dÐï턱®-Çm÷¦þ8YDѨý®ØX¬-N½|rUh2èZ,§%ì >ãLž>aŒƒÿ×€ycósYòåºX„=¼^”¡ˆh ª€9xo™Óñ8ÐÕYåŸ?y{]‡ô^£¡5î®c‘Òì0*Ë_P¨¯·ŽQ,F;‚Ø8f*™—ü›©YXêLQés[úíq«ê$±SYžŸf•p>ÖCÆ#š< Þ,{Ì>H¸Ñˆž8Ú].°zI I5P Ȥ—ø?“—ÃJ9-¬ØæÅOœ4½3Ëú®Œúc[Þ;£Y– &Œ.Ü]ûü?Ë|9Ç%bEukÌ:ìVVVº´÷r]y-§ýä¶ÞˆP–ÎY–Ÿ1€&ŠrHé1+8ë[ÛÀæ;‹x%¤AFebß 1ݼrÿ¾;ت[ù—PžþéÎÒ;†•lÁÆ9îÆTFÛ#tËËM_LÒo-.–ßN¾´õµK‰y,÷‚Sðñ¥PqÀrÒø$î92<“s¡ki7–®"ƒMœˆïLÌ #a˵ôd^Iû_BYx†éŒ NÊé¥yoUk…¹×-¦Õcº– , ÞXƒþéø…YÇÆÍLF=Æù1ÿ5iWB;í=$Ù¯®ÑòYDphÈËð”¡ÿ+/Å0Z&ؼjF¶õ‹z Oòu NõÌð6hz¬–Úi%ä±ðROS@Z}LJëk7þûáEø‰=>Y(„NaslÒ"¬mé”Ûm‡Ïl4ÆT¬=A0§=¹7Ë“ĆO@ììK¿UåãÚ¸ Y ˆÄhìâq2)iá‘ ÓŠ°þ_‹(™m€YР¹ôë Œ*Bw „äÕþc•ñ2¤r R ]-Ë/Öey#†&5ä‡Óè:òjqÈHÌLŽoK´òwšu/,.–öÖ6· ;ÍxÁâXÜ©¨ Šñÿc˜²ÈæÚqñ Ù?–|²–±X˪MªÜÚº\ʬq—«Ê¡™ƒòøÿ›Šä%!Ð3ˆèJ*M#Ë6u»‡B²»¾†_V9îd”ìLµ©¢õä¿Ëâ‘êȈ†!æ-bÎWC¬y9í­¡‰ÄßT¹•Öé¦u ñÈO3ʼo—º1—BÕ)@ó°Çlµ6ëXT²òŒ–6w¬om­g˜ÊÈì7¤ü•8•ð9g «r‰C§qyùc¡ÜG ÷bëH¹¹ºXL€Ã5¼q”;º ’üL?›#âךL/“óäßš´»˜mìý=U'õ¶[ÕìE¶»å{Ë«›DD¹¹ô›ë1“/!r…I>ˆäjC’Ô61«Ã¤é·Q‹nn´ûëXßP3Û35¿ ¼q¸P>8þ._³–FDóD¢ô‚ß+ùÊ;G××T…%´ŠÒ(âŠTÌÜ líðã’èSŽQ<ØÇéÝ>á­]>ÒJÍ$ó²¥Úf¯ ×ì§ìå¢ùÛWäã§ÙO4)§¯§uÀNGÙJ’#S³)í\1—zA]è÷–VjzI¡ïfQŠ·î¤àßîß³“ =Ë´­'TÖî`±·ž7»¸,‚ Šz*>.Go‰zS¤(Âù î´‹•ºx^HŒÈH#Ô켉ø©ØSýl1Êq’¨þZÖ’%¹m>«: !”!e ý“U®Le rÆ{‘+ÆÈŽJšÕìÀà~Y/ˆ‡›-Ñ5í6ÇËW -”s]4íÈ@,±²ü¿ä‘”H›Ø¹@G‡tW˜µm"൓ʹD•Qê ü@ñéZõÈÇ‹«ï'§§Å„’F’w Ì—‹$ò>«e…æ[;™Å¼·‘™aw«²¡!r-ör9G*Lßt.›æwŠ;™fá,LÖë J tU7§¸ã@pJ)‰ï_cçy-¼»>•-,×O,×,ƦØDùµ_ÙÈvwf2lQ^óĶz}Ö™,^¼W­äûÐFÀªÐÖ½)‘žLrŽE%Õuˆµ Ù€ýiÐ-È;¡að†^àšåñ %1Í^ÇËš¤Íl$•mâQbbC©d/ȧP›R¹# w,ûTü«òõ¥¥üÙ–KYãT…ÇÂ@>8Z”! ø¿ÉÌOÌÙoð Zœ?—Ì×w+awk…Ú¿¯4S ^’/Àh¼jÅ\>6Û§€ÞÁ'ÒmWLÖn|³*µàzÇ‘Uyã欀Žœ€®LÊűIN³kõ]+M× 4wŽÓ¬ðµHøeâ~\Q—'ÞÌ hZ®»k>ª'Ö%ƒp„˜ý9!Œ7éñc{±£t°Êâ")veZŠ†j•§ü\ca¨HÍžhÿ›÷}µ©Ó¡º–"ck©ÅdôÝË >.;ôÌIé‰<Üœy¢âÖk_˜VúÆwh4“Èþ³70c,LMÙÜ7¥jD[E$këTúÓ5¸†»|-‰”“áÆ™*è?—×Ö0Ãqröš¬)Lßa²‚iSûC~YD²Êù6GÜÓï.[è:\‘Åo¨Ü]4Ö®¬³²º«!BmÐW–S3}Â'½[U^­wÖíbF1´Y+ÁùÅ@xºSí?ó`Œˆä™DZYgå»ûmSPµµ‘ÒÌð.˜€ì VŸ̬+’ñ1(+í'Ì:x¾·G[!y#xÊ–Ï% ­Ju퇌ˆ”˜kòÙÇ,‚ˤ2ÊJ2ÔºüT îë„Ö%–þZÕ.ÇÕÙ·P‘)†œX­JÚÆä†)MÇ•+¤}8ó1ÈÑ\nK%»WuÛ®J96j”¤ú†Œñ¼ˆÐe.áj PGÊË#5 ‰3ù}»+<€¸îÀƒü¸N@€ ¥76S©·ªÔÞžØdIB4$ŠÐôÃÄ‚´ÕhI#j}ùBEôSœ«¨ª€ê>Ðý¡ŠAC)S²íªŠ|ñPѱ´¶½i†ËTæV ¤Fœ»`÷±ºL­ôˆ«[‹¤‰;/ÚbO…0ñp“Ñ4Òt¥q5écöR?L“Ëo ü8|JèÇÂ$óGCå{FYaúJÀÛ±øÕÁ4¡¥xöß‹ä¼µ«yNãN³úÁžÜ²²ì’%Z¿°w#oµ’Ž`ƒˆÕÒU<¦VT¤N£áåZí¿O|º3¶DzµåΟt†)d†:‡(**;mÞ¸‘|Ô{ÙŽù‰sgBÔ ªÌ„ŽA*€Aöʧ0•Ñéù”.AŽh–¤¬¼ã_‰fU¢1ñåör³…´dòdZoŸ|·u§i–’ÉÆòÐ Ë­ôÍR¢´`ËTuÊL ³â±IÒê¶wÏn4‹Ô¶¸…\Ú‡^IF^_úß³€ìËjBÝy¦îÞh§Ô-庖(ˆŠkAñð;H²ÆÌQÖ½¸ä„;gÞë7ÞWºŽg¿ÒÁ·D‘\5¡³–'m`¨øi_ÞÇ“a¨˜¬Ò¼«ä;‹_«ê7Ëo}p9ØNäG€OR6hœÿÀäŽi1Ã~AGÌ¿—š®¢-ô‹ƒÎOÝú7\ˆ¥?x²Š!âOüÕŒu2êÈé€êÅüÁä›ý.Þâõ¥Ó uŠIñIЉŸæû,>Ëá¨j–¬m•*z½¾Yu’×¼Z°TsJ=kN tß' ÄÄôÿÐå‚çË ÓÜÀ÷wD¥ÌÌäqwj,Š>%Q¶fŽTmÚVž4ËöKi$[‘i3€¯GE4`®ù‚DM‘$2Ë?3jTÕ`½ÔÚÚÞ;oQ¤`%ªÃ‹]Ç͈sr0å2Y¯®´ÏB0ñËõØÍÍÔpHá™D)7q¤”\¦Xï’c=襘¶GZ–+»+;{™n­Å¥»¨D)™”ƒ»lœ¾.95Û%`17Ð!¤žåäe¸ªü$öðÈR)1€ÚÇneº¸ã/¤ÏmŽEåZWþUoŒçµ³ºµÞ¥zâ^Y¤5TŒ§& íÈåb]í†=ÏMò§å2Mgaªy¦Y½ gú§è‹m®©ÿv9ûä¨ø³y«`Ú1õ/FÒî,a×åòô¶pÚ¾˜†K·QÆ+A%dsW2;}¯òóÈór»˜ËyÒHdÔµ%²úÄ#ZßGQ_¬È#D$쯨2b0°9§z'œ<«¨Ã<§”WŽÑÜDjUBÖŒ|'—®Qlˆ`£týo@¾µµŠ0ml k<ðÎÂ7+È<©¸Øó_Ú\HH¢Ö<õ¢ê³MüÐèÖ¤™$ÿ‰&…ËEè•4›Ó?µ’,¥º'çVœ³ú$Ù´víë–ÔX¥»s¦y:z‰¢²>|e†Lá(”¿Nó×–<Õ¬C[¾ý¸Ž8´S’) ¡%L€.ìÇ*}œ<ˆïZâ6 3FÓI:}ÝÅ…´¨{™5 kRÌ8È8ݼ(8Êãef)‹Üù—Ëw6©èri3˶í"†&™ E!-Ïãåñ7Å–pHrkmü—icåÙ5ÛVCck¹Š±´î·LGf “¡cáR^öbÃXÔÓÌšD¦Ú½¼’´‘²#$’õVE#‘E-Äÿ.5²ƒÝe–t4¾ÕO×nííí$ŽÖœŒ¡„´Œ²ƒÄÅ7*Eña3Ûp¢'¡Bêºÿ™ôYµ‹+¨$‘õ ®m彸‘øâ'ájtj×fý¬1„O%9çÍ+—ó?Î6¶JÉi8xÇÄ¥zeA=¶Éø1*s976½q­\Û[Ý, ÝÍš¼²ðTŒž2S~N¿³“á5ñv •úù6Öm~‚ÖK†½ÿF(p´ ÿ!<¨ÊF›<(‹)¼¹¡éƒLÔ4Ù›êW°Û»Ð±âevçÄ·ò\”&NňOðÍ…ëCk§ë'R–®-ìá‰Ù‘Y‚“ñR¡™¹|8F@:R%Ž] w¨þHþbi^Á¸H¸¸¹·U+ÈÖŒ´ù`ñ£-˜(îÅ_ÉÞi’Èê­¦Ï-‰$Év£šƒBIb+O§$ Œ¯tm”>eÓT¤·ZY:H’„0õV > K‘˜‰Dr©þ‘¯j^c¶‹Ë·º®Ÿa´·»½´ResCêê§ágþ\;îÏŠ2Ûd›¿*îl’Öá²Ã9h¥ý#I™OqÇwÐÈdlÇÍבÙÇ"ÆGÊ›ˆCz9RŒ¬GMðFeÑzn‹¢_ÛÙÄ—³GrDOofVj\‚¯Ûû-ðåg!¾M¢#‡š&ãÈióDÚ‹É%¤ôÖá©n†@çàF`Xød&7]ÐôÀo/îg˜Gå ôå$PÅÀŠ«/ÙXÈyÃÕ#´7­cÚ²Û<±Œ?Ã$­]Š1ã„Žõ’'JƒÍŒd¸ô'’!ûù\‘B¤šª %4Ò<æU’Fát&d¹(3[=»=wôÛ¦U,Mƒ"§˜”þ’6:mЖh™—f«ÄT„!¿nˆ9à€èC)J’«]\Ý[MQD¿ª.áUæ?´?“- 94ÝócŽ !²•dh›kˆÁR+ÐÓ¨Éq÷£†–Ǩ\,ž¬SË!ZråñÉ[ý‘ÂSn›Û¿˜®-acÝGmU•Âõš ûϢUsv¤–óDc¸ËvÚ b7L¹s@]ëÜÚG *¯ V4 }ò|-`ŠÙJHlæˆÙűLj„p‚—_Ú[)p ¥ |z£m˜%³Ä¨ÜQªH=ˆ8BIC0>±* ÏöÉÈÛ&È¡öï„*ÒOn£UQ$eøw¥qTTÈÕ,ÈÁ€í·\4ÖdÉ­õ;h–h R'ÙÙ~Ñ 7øºâb±!_OóMÔSVÞö[HcC‹Š²­>Œ#„K ´¿Vó§©(wä§ÂŒcPiãQ’Ž!œ¦[%ÑÊ—jÔŽNéª@–eå½Oós©Ô’ÜÚGÈCt¬ò$tttÛÓV4ß!2c»8‹ÙVóÊ^aÓì¤[C©i²ñßÚ7^êGï  =XœuÑJúêÒ$±:zCvÆ6iBb•Žõß¡ÿˆ¶ +Ê,ÛI¼‹Ì>[Òô»8cŽõdº·º‘bŽ¼Âz±)ËÓ Ë*‰_D„hódMæ˜d³Ô,M¶M>ÖúÙ.°^£½9}UÈøxšÑ?o)¢w.DaL3@üÐÑ4½NõfÒMÆ“2§,Ê{fâC~ðüEd'“æ˼)Ïv¾( oÉ£ùâÒöfQ‡…ÐP¶oJêMPOÞ/ÂÍ“ä d=Ámî¡jZ»EŸs§¼‰–(êÅ>&D"qæ’"HÝw–ÅõŠO}&§4Ú¹Kk[¨XfˆŠµä‹ðÿ/Å‚Rr,“WÉ›Ÿ3ùVëëšEåühú„j†x“Õµæàшê?gý\Ç1<ÜˆÌ ‹ÉüÓå{õ¡7v÷h1O•NßdüJ|W3pÌIÇÏH+mNk@к,ªWà×j ù‘¨8∲ÿÿÑâWˆÓ'Å$j ä›­GŠœÏÇHu„€J ÙÓTindró«Fò†£UÇrD,YuglÑÚ²¨Kle‘ˆä&už‡¢ ørœøÅ¢<ï©\Û¶› û¹Äáÿß‘ 8 ÿTør¸FÖf’H<Ïp—dÆæ+n¬jMhT/Ðßf™>2ócœÄ’GV>9`, CKMÏ%kAÊä8'âZì†6´åKÍS“£Ê`|NvþTÿ†ÈÊt¢ ²‹[+ß-ÚÞZÜJÕïmÐHE“Ådî¿rÊe¾í‘ØRVÔï¿ÄSië?£eg²@£ðñ§ZÓáÉDŽl$&'5Ðd’_PµX­¹ fDr4p(MvÍ8(HZ*šôÛ|&IQyC+Wâ‘›v=€éL›.îȱBwa̵+±5”ÇŠÙ7¤/ ņ1“³Õ§Ó¡s<—ZŒóC¦»pAðªý¢»x`²¼‘è—ºŽ£ ¶£}"XhÎäÏw,‰îãOQÂ+FB¿gáûY™€÷²†#^IÏoqÎ-2ÝØ[›‰¥·v„˜t^)×ü¬"g«MXè×s$2UÓn/îª-œi#pÏ(çzìÒÉÿ ˜Y%gg&&•ÓS²ŠH%wsoIo.½@Z[©Û…#ÅtÈìYB¯˜´=7ÍO-âß>·¦Í5Î¥%G|qð§ÃŽäU1Ø{Ó¼Õ<:Ý…ã2Éq(šÀ•øJçz)T^qÿ•™>&¨Õn„qÓô«K« .É.#ºŽ5–ærÌÜã-ñ Øo^˜N2TdˆÙ"Ö¼Ó­k#ßNd(¡(¡PQV‹N™8ã›>ä±g¸MðZÔo±ËxAèÇÍÍ#ò5cßÀÕÚ¢-Ã+:š”ëâ1´ÙèŸù_Í:Ö‹w ·™Ì‹ýW™ ÍÓ‘ùesÀ 8g#Í?ÔüÙ¬_ÛÙ™Á e$ïÀPòi .âžäa€É›nHoYÕ$Y’IåKgCÄ *• à8íN•Ë8÷09¤z¡£óçœc SVºœSì»óU4 øNÛ„°G¹´g=S¯%ê?^kÛ+ùe rœàb‘™å†²(.¥Wâoæÿc”åÅ\™cÉæÏ´íJÎ /PÓÑ¥Õ®î ¼º»Œ«ø€¬Ë*NXÛâ?3f9»lØоmÐt­FiáŽ+¸lšÖÝWƒ"²q4ë/û³' ”wa<{PI¼çä] KÓ d¸’;èåô%€*•oA+ê)û\Y5pÇ5žJq…î€Ók‰â_®˜‚¥Taw߀ø†d ìÓ(n¿Tó¬º ykPô¥]"àÅ â J‘Ëö¨Ù•†ÂlQ <­æ 4›;ë»;i«ÇŠÊ@¥¤(ïY·D _µŽXñ2Ä@Ýê~^üÌŸX‚ëLV–;û›v„\Š¿Âñ”5¯À£bÅÎbKNc»Œ%ïGhÞm¼M^ÃB’gãÁ|SàŽGBË ™Pð“ÕO°Ø˜º8â(Aå;Ÿ4Ù¶©åíJH¡Ó –)t‰ŸÓ™LSþŽÜëUX‚Óù22A@)JîûÈ2Mimu¢éÆÚC,¡ÜapŒcôÁCZñRß˃Škàƹ:ûÊÞT¹Òf‡E¸¸ÒîE½³³[¤’?¬&ë@û¨|f÷H†Íy»Ë¾fÔ-aBÑ/î\‹–„ª´Ð„â U&nG–HÍŽ×[°q–ašñuÈ^`[}>Å£eÔ3€ªª¼˜ ¶dqšÙ«†=Kó—ü·§éIlUo%CqðRMatÝ}TéÈ.NdNèž(Ä_T‹OÐaŸTKY%0­ÁvD,h›™ýßÚÛ®^eA¬nÿʾ°›S¶Òíu#¼ž?‰®# œÄcõ+¼Ÿe5teàïÍBãòÃ^Ž«Ú¼n£”‹¨Yi½7ªöÉŒá>ÂJ<»zåV—mä¸(†¬¢#I«ûJ79!‘‰ˆî]•µËˆ#–ÞÊI’hÚThÀ ¢}¦ëÐd¸é‡6­¼·¯ÊöQÇa;öÿA@»ÈÝOº¸xöc·šu•¼û>Ÿèëˆáº«b#W†¼‹ôd ¢Ù‡•(jþZólܯot»dE&~5VâxÖ¢¾(äìeNì~k[ÈúѼmN,\Omò|WɇÐñ«ƒ·};Žù"m¸‚jìðþÜbRvä¾$ˆVb‚ Ò¤m±ÀdYp6UŠBª û4¹mø(ŒHOî×L}"Áƒó¿¶¹²q/Nc΄÷e¦ùWºl1ÓŸ^¼h›F·+42O«(C(e6U[‰ø¾,Œ‡{(˸(^@ö(-µÍRZò.-­‡ªC¿'b)×Ät²™êPCZЭÜËšnfÿ~_JÒV¾*´Zd„O¹Œ¸:ù£S¿¼K‡ô¡h”$0ìj @¶H@:l§y©ZIoŶòŠ‰©Xߖ⃶øˆ§ˆw¡àj ¾£ ‹)TlzïòÉK—&ù¦Vv“D«ª «y¾«=Ñ¥á;ªÐбv\ªg£d"Níë'Nµõ é]NÅ$”™"(G"ªE(Àäcg›:ˆÜ$¶÷–\)4]e,Å«pnŠ:²r‰k a2]­·äy"!#âñ 1&†é¡{&'VÕbОÊv…ÉE*²™)9PòÓ¾W(‚[`Mo²_µø-iºûceV)8·_,LQöŽ7¦ŠÖ¾ä­‡ ´Löôç H8Ÿ Šãl„Ý«-6yd ÄÔž„Ó|²$m‘èÈâò£p¥Ä¦Ó?Aï¾–!b$z44íwÊšÚ˜¥‰¥ ²8x¦ŠFÝMz«R‡"2FA™Æblª_kÚÖŸ+XÃ!³H¸C|š‡‘ñn½éJ×éÀÌ'zwõ» G²µ¹h øʃ͆ĚdN;eâ®ûYÔ/f’[»‰&yÜI)v$³ ƒ|"¹ƒRjwsÜ4ï)²•ä”Š‚“ÄP¢fñý‘½=ûa¤ÀÐw­?FJ˜´¡J†'piOÇ€ ¹dhÕ”:DÅ“éÄ%0òþ“y¬j°Ú[ñNÔ«tñ=1ä,¢¬ÐfΞQѵ ìî¥úÊZ3VÞÄ’ñâB)ð‡O‹ì¶Rg#È3Œc{±ÿ3kzÞ¯8X}B$·Ž¾œAÆð^\q„æ‰Ñ6ü¿Ò¢’ näI& A,“ôå;ü.þP¸2ͲÙ™ÙkžSÑ­4ñkºÔÕEìjýBÝ0G|(jkÇùs™ÈãÞ¡æ/:DҬμ¬Æ°ðÈ‘Ò²E !j­¿&øŠòà ee*+´Í{DÕ,#kÛ“§Æú•ÌòÚT™YvÜ¿eEáà òA7Õ‚ëšîžTËh© G –n(M H?åË2±ÄÖî,‹žîIääíØ-@Ë‚ •vßoIZ\¥9o^'z ðD©^ óQÅƼW°ÉQ<˜ì h=UB᛬ƒÀac)¢â·IâïÉZ”¯BGL—s$N—d·×h³¸€°©$tèÛÇ®@š €³²4 Ø/n H$[ef¢ß7CÁüG M†A¿0jw’}jÙåk‰fXÉp ç T|l¦-¤䡨é×N –ó 28RG‡5ª†Éqß&Y½†³­\è:”v—-Ö –æ5Z„† ­Z wfoòr™FÎíÑIç•ÿ0Yí„7?éºÖ¦óD·s¯(Ô–‡Ó&¨2¼¸HäÙ(#~l¾ÇDÐuƒ¤ÝL®!ÓaK/ÞþîCÁé —¨É}æ‘3éðJ-íø€L³ÓÓT覘ÌœØÆd³ýK̺„p¨²š)ä/‰wøÑ挩dÿ+‰í˜Âȸõb^yóÖÚDÐÚi^±A%ÚÉÎHÌ‘UÇÅð»W~?k.Ç ,'(€óc$S]DuÔ›L†uç ñ¨”zŠ FÆ¥wøé™<5Ëv“>&[7•µ=.æø– jÁ’?¨%7ªÆA¨£i6I2®+e¼y‘WQ^Ú&¥a¢ÚýVòMBÞ&‰÷‚%ŠVsFä‘ÍðreS‘¾ô¹&ú˜,®¤¼Õ.ll­’òÂö'.ŒèN.@õU‹&GDƒ.¢˜Nµk®éw_Û°H&–Þâ LÜÄ¿Î6e9t!×DŸOÖçím&yO^Jëqa s †HÀ äÛgª~”Ó<³§Z&£uõ€ŽÿVž£L·ËùNæÌj jÒ%<Æ…e/ÀdŒÕy*žUÊøä†'’÷òËF¿ÔîY¬BÛÞ³OÊ!A mXꆂ¿‡'ä¹aÉ ¸ü™ÓÜÈ×Â8—±0q˜H±ìÜÃq(Ü¿g,¢ƒ‚ù”Š/ÊKéåh-µ;U¹W–!op'ýÒ‰#B¨j¹!¨š)Š÷Éb³Žéþ®&†Õ€¸–WU;vëO‹íe±Ê \¢GDëËÚN‰iKæY]‹Iõ&R¼¥ˆÒûLÜNÜr™èÎ0¾jº·æ - ³Ó-„Vê?vðV1†NìŽAA‚]ÜÜ\Lf‘šVv~¿NeF4Ñ)qn„2 | —åôcHâ\?OÿÓàÖÚ%ûÁ÷ªlí7’@yëð¯S™°Rš\Oùu †ÚJòíÔ‡™Þ8£F§ÂB€KüY$Rb;Ñ–:•äÑ4˨Œ·šó5­å£ŸMbŠúÑ5>%@*ÊpqË•$ÃÎÑÒÚMå›H<Ó¢Ü4_] mkEQR²w†˜>­Š’aîf_—–³så½CKÕnØÂñÉ=¤lãÕ&O±Bw£R‹”eÆrc.(òH<×­êúf¦i·º|kgqnŠ.̆YRHDz36N0¾EÇ2èX4ºýÝõ΢¯ô¨¢Ý­¸ˆê©Ä‡_}ªÃ2cË› PÉ%²•«Wµ­NB «éÖKu+*õ ­áÅENLdeÑ0¿Ò®íàE–ãWPèã«rÜTä¢`dG4–BâGåNGcL ÀØXÕ§_ ºkfÓױÂQKø@=@® TëËúDWŸ[¸¹vŠÒÊšYr¡Š;}¢i“$[,Y´Ï-ùf×RÒeY5}B¶—nF)íijToµ˜Ò‘‘¦Ï [òí¤WšÕ´WnD%ùO#ÙQÍêÇ£0\·`€Jtú”‰®¥¬”Úœñý\õ_«óáwý¤,ßäå{• r(K«7}`ZE#E Ä°Z¤ÕÑHjul•l±‘™?šn4 Yä‚Ø µ6OM]‰"5BôÛŸÈc$ôewy«Þ¼pÁéqŽi@§"¿:fP€´ñ_T Õô“(YªÒ½:à"ּКíÓ¿ñÆ›]à6ÊM x @´@µæ[  uïLŸ WR@ QÔ–¥Ï gH‹ÜÊJ-Ôî0É^Å}c³½:âÈ ‘ÖO²'¨þWão+×l%9'zTfɯ*Ωo"Ob§o‰ð&™Täj™Foi¾–4Û?ÌÍj÷1K} AéŠþÁû[œ¢RoŒ"Fé]Øþ77µ»Á,±¢Ð–n ²~5Âl„Gêf61i:¬þd“U’$¶–Ííõ ‚j TlÅ‚q\¦Ì[hN×&±åû+í.Þ)mí-EåÙ‰ªfõ$>¤n|_ËþÇ—5ÈôÏ-é¯çªZÁ,ÐÃ]Û[Ä„M=@ B(®?àr{Rœbí4µµÔƈ£êíiv ¹žÖ^bœ'fæ¼jv# jÙq]¦_Ë¡ÛH·µ—HKÀ¤qRÓJYªÃ~@ŠþÎ2%®in¯ùK\Ö¼Éi}i릨ôŽïáån=5Œ¯#Gýá2ü93D"‘;¤>wü­knv3¨±‚ÊA+È=9¤pjŸK;|²Ìyæ×,R"òÍV૧¦êuþR( ûÎd€ 4Væ%žHãŽ`ÁAŠe†ÊŸÃ²ãOóŒ–_¸Šå®Œ·(äZ᱈=²$<Â7E󶛮XXX$†%Œ`4¤Ñøn™\°“»lr²¦…y¢jZì©!ôâšA$ñŒýšž¬BŒ–õɪ<Þ®ØÙjPéväV õ„¾v»Ÿ„x‡à#Z“G9‹D–ù‹‘¸ü¾¸D¹aÔo,I{fAñ‡]þgí2¹e$Ë£g†:¼¯Í¿š7ºž¦t:Ä * ˆçe±VK‡ ñpb=MÔþÖ_ ªÉa“$y:_5ùSX³žÂ=)gÔ…‰”ê´òH4Ô…ntVLœc0ĈÉ^y¦ÆK)íl-JIÔŽ;Yd ßʳ?OÙañeã<è°P4€¶óN³oo-´w"žA<†¿)N\ºòãð䥄5ø¬ßW×á¼Ò4F-dH±¢[êzT{š%)ž™ 4Ê#%TÝ"LnÒ±«jé^¬2þŽktKYãRªÖ¡tÚ•ÜäøZøº&:΃g{¬ë?£åiÅ‚(¤xÄLeqûº êžŸúØr:E•í“…’¦µSÔ\ (*Oì²Ɉôgƒ³,´óÞ›6™Ç Ú^Ú:K(Œ…Žv¶@iSûÄn ”K½ÛAÉ,¼Ã{¿}qk¨¬z]í¢^ú5VX>%Cð·òÿÄrž[·Frµž[¿Ôu9/ÓT¾’¥½!CÅ0Z! ‹ˆO¹ÄP€=«“»`´)‡f¥M}ñâÕSÛ "ª†DÙæ¾B’¦ãâ­hF I÷ ¤¶>jOZ#½pÚ8Pì›uø‡† Oèœ[‹;{H™.øÞ+Õ>ûØår,¢<Ô¯õâI!Dbàp”,(k¸÷é€2PÇRd†â(8MÅ–r:WÇ´p çÔÊ.EÆíþP8”欋NÕúa% $Aò'®,ÁS&‡Û¾áZtØ~¬iZ'l ¶›S \)\•èN”DR8 ŽÂ›äÀ %a §Â>.çÇn˜X£ìcº¸ŠÊH¡èYEOÓ†ûØHÓ'œëÑO,ƒÐ¸‘wõò–¢ü†GŒ¨sdiùƒuåè­­t{m`ê²<õå4ŒËŃ8û&¿³8Œ’Û˜n©® «èníí–Õâä‡wbynÜL¾èsjË+Nt0iÞ»êöŒÓHœcº‚SnÃù•¨~.Û}¬Œ±×$ ïº_q¬C Äÿ¢¤š->NJ‰9 V Ój×""z¶™¸O4#ù†çOý)en5 zE4b IËzºªËN, ¦H7º2ËG¼´˜Äшþ¼¯þŽÃÓ–&jŽ,%_ÙTüY?6B»“MKË×z}¥Ö§¤ÁA£âié©XùmU¨<9dFK4Ø#²Vžm¸k6´K‰mnR?[”-ÔTGðS¯MÆ LdÌ>÷P[û±q$ ÊѪJÇ“|Uû~$€)þ®eB42Ëu 1c=ú%ìÂÒTyãBx)­€Ý©–C˜k–áÿÔáï˜/µ[“ëÈËÂ@nª¼EA¦gc^M›BÃ3È"†6bãŠ14«fE5›dTžÚÕ-ÑÕƒH-d'â Ÿõ•Ê7ºD“‹Í{ÈsùKÑ/!¼³šÅŠË-»äXê2“ŨZœsănA© ˜õÜj#‚Þùîmc!•ÈôæjAÞŠ<+Ç,»Q2PÚ¶©õ˜- Ie–;uâ¢CöE~ÏâwÆ O2„‚Hb_PËöE7¯Côe¼A ‡S%PP*?^ XËBÕâ°’A$>¢\ ŽF…R š{ä K>&õíEî/YùHè-€¾òÉGf ,¤õ'â=÷ùâÛmô58Ò×mÁé„%møžZÆÕÉ]0>Iæ´‹§¾›cU³‘•ä¨£³MÏ^5=2£d²d²)Ü8âÄqÜ{TSÉ1Ó¤X­ï'‘€„$tõ$øjÇÀ/,H4‹ Ö–öWÞ¤ŽH’ޮㆇ.jÌþP¶DžJw—y‚ñý]5Öhæ1?¦§ì¶ã¾â¼yo‚ ”X7@¾¡„VíaOɾòß·e‘ÆV·Xômå‚HäY‰“°<€v¯û— î•]ÞµÂÇ  :$²Aœñ·@>]pWrI^!P~'Ø0Rõ¯\’8­'Ô’(vú2VÀ”à³oPHOÃö€ùŒ¤š\. A°B÷ÇŠÔF”kAGÝÕW#t*ÛIûç Üh­¹ß ?¯ džE–µqo§›T$Bî ¯b§í)ùšdHg½"m5ÉRÎâÑvµži%‘+ÔºQwÿ%·À`‘!]ÈD,¢ÎcP¨¤H{Ò¤ ³€m|[§vRÍñÜÞI=¬(þ쪟‰ŸÅÏl‰¶\AOMÓ¥7jªÜ\¥Ä&‡o€Ð ¼p”uÙ™èþgÖ,ÒilýH®¥ÓංE¡ ,!ØõZŒÇž+nŽJÝè¾RóV¡ªyzÂîòáby­&kš)fI"zT¦ceÇÂ[£“ˆ;ÎwAåÍJ{«…¼‚uD·£¬FG$¶ vl„Fë"iŠ²ù*Ö+Ù¢•¦š{‰%†2¤HЫ${Ó—FËÎIraCšWå©oï§3^K/îšãvbåR†4^@žŸk$i<ÒoÌ#¥É3M¿¦÷ $Á븱ӒŸ³¿-²ÌDµÊ#›»7¤¢­¹Qìd_V¾U/—-#ò•½Ä .¡=Ç)£|1:;Ô9ny;)à ZC{§Mi9eÞ2ÜUÆâ¡9uùdîÐ6_Ïk=­òF^2Æþ$1ýãRA¢Èõo2Ýê·’]\L·bCk)ŒDAu«þ]Wý–W46g<‚GpÈŽ¡c¨-ì·6›µÄ–jCªÕŠÒ‡}²$‘Ì$€yazÓj:³H/¨–7S1Ê¢AÏã¡ûùfÒ‹Ê¥ºçÍþ`¼b×—&ä±SêHÈ¥>ÉNJ~GÙd<é,–S&ïZ†¨?<º-$^í*ÉÉT©Æ€Ö¸$€vO´=Îéd–þøéöȵYJz…ˆb@¡ÆW9×FÈÄÉê^XÔ|±…>¥^ß]År’Dð|?X ª¼ò|2¢ïËÓelÃÈI7Täã…|M_ùzâÂÖ¸õyi:ÚÛ=Ùø&W¶˜HT+ðì?ض0Pl&z¶‡¦ù–6¯Ör[7§éÄV¿2×ír^Ø##˜ñ<–ÿLµƒR½·¶fú¼s¼VÍ%¯ÂX¾Ï\˱m@VÉ\¶2ÄQäY˜ß³n$¤d„ØpîÒ+ð“AÔW MÉ/®Šñ.ÅL^]ÌuåFúr<NI#ìõ‹˜m’Ûý×RXÔïQ°>Ê~,Œ±Ê9$F£2Kô)Y?ÍD0–ËNü¨ÕT¬’º?ù,§âW+–¶=GO"œ/åÏy-b^à"uùšåGWlÆœô ž“å½_B‘ä±ÔQL‚Œ‰QÞ€uÊå˜K˜nŽÝ¨ÉæË»U‚{ô’4‘d¤DÃ’´:|±ã&(Fµ²Étb¼H$Xä*¸n]û9!¹D•=J+)®^ú=*4’F <‹[ƒJÀì~MòQ̃„Ø­Ç—aë%¦ [ŠãÞ´Fû_*æDr†™c²ÄeÒæFYŠ3‚\:UÏö>9•‡(â 91ìÿÿÕóÕìïqr̪0LØÀš·†#“%Ó4 è;›•0,iê£0Þ„2Þ1M$I"Ôf½{‡h«é¡ aZ7­>œ‰œ8z ¡‚iÝ›®ïØøíw¶w2Fýmäûkc«¨Ï3ÜÉ?²ñU©Q•’|–dWšC{¢êV¶ñÝËo"ZLÆ8¤u+VQS±öɱ˜@oÊÓÛgMœhÇçýq´.V§QóúvÄ”k¦âdfRYA¢òêGL”)lIa‹&÷'>Œ(EC¤ ’ë@¹lh5Ï}‚Û‰ýBv^öW#i„xVPwšâ)+¨¡EFàV¿«Lwd4v÷ÖßS’‘ hýVPKze‹Hôñr<@nYp“Ëš}¦Zi¶Ú½Åœ„†6mñN¥V©><ËaŒq›Ü±ýføß꺅ۓ,F±Å!²¿ݶb ²§–SÙêwwnÍsÆ8¬BíRo`ƒ ×$O4²ê.6ö’s'ÖGn' £•ÛçL§¢=+M6=2@/ŽYÔl#ïÛ(uU/IH(A–Nöbc¾Î3­L€QÛ¯|I¥¤h;|T]»m’ f¢ ]â4û!š½+¾W* ‘âCƈìĦË<šI(vžŸ~<ÐWP@;Sáí÷¡¸,ŠH$ µ«ÈÑêm~Ô|De9!a¿Ý¾cÿÛÛX_]Oq| ²FŽIVX ¾/•pïL¥.!Vô‹ÿËÒ–çOM:DžŠHÌÉÐ1aJ|4zcá½¥0hwºN„ò öÒâ)5xLqÉÎ)"#nàŠëUãß2 @i–,=@åÁ¡„û ¶ÑÑSÖ™FŽ*@鱨ÂM V¾œÚ‹q'îÁõ ‘û\xõÿW R“b›Ži¥ˆÂjôJE€SËúäL‘HâíY‰E¸ª¨ Ó‚2÷ý¬o¹$uäœê:¬ñîýQ-ç»Ùàbˆ¾¬`pnì$ Ó+"ù²¹ ¼Ï®éš„(-,’+¹ 2ÌÜÍ*ÑرêØ $ )Æ4—j_£ZÊÕágP®]‹U…9ñ…rë-"½N.f•HÏ ÝÊòŠŒ2–Éšé:F¨kz}ͼ2?„41Ž?¼Ž:²üYGŠ@Ý—† ÙNo%ØÝjÚÚ$³KI"–~%BNŸjCQDV¾#%217A³[ysTòűúÅÙ³‘¤¸†h@àfNêò)¬‘TóLªDÊÙÄU—§-Ô“è§Wf)b"i™£pJŠ0>'1NÆœ€6·ëwz…Ž¥=åµÇú%íº^[ ÈÜ^5ß~u®ßäæ@!¯Œƒ²–”|±}¥Ë&«3Z/ÖeºµôèY•‚¬ŠÕ®È~ÎHúy±=ÎÈ$Ó<œÚÇ©µÄÃq-­ÔŠch¤QÎ8GÆv¨Ää=ÔÏÁ=üI¥§éð-³Bä4±£Ê¹Î>UWíU[,ŽBÔ`ë=Sh­¤`çŒ[S“q,xׯÂ0™W4'úW”ôÎE«ÜËáBñÁ^ñ¨W÷èßÃ3=G¼Ó3Ó´ÿ/[ÚFÿ -^ ±«\\;ÈD­AB\Óâ')”å|Û!w 5]{Ê|ï ç–¬VâÚJhUÇ:©®øŽ3Õ™ŒF?uæ'È’-·–­yp5QYNíÉOÅÈd„'Ô­@rg¾òã|Z,öõ{k®C¡5 *‘ÿ –0ÆB§éžB{Ûf{ÉR?YXnÔ„’"FÞ¤uà|vÈK,»”iĺ½"ßVü¹ý&-#òŬ°Jʲ]ÀÂãá O £‹r™Œre=[?/Œ2?-ù‹Êº…ÅÂé±ÛYGâÞ>q,~³ÊåñÔSQÄK̵¿+Ãi¥Xj 2,z”±Ð1<‘g—’Ój|Y“ šj”%I-¿–µ­^îK]:Ýï='áêƤªOEŽÀw9. 9±¹tMn/oôR]`G$mÆB°¾Ò'"’(aSTø_#ãDòIÇ>¨å“Ëú>–ñ[éqI¨ÀÆ9¯úŠ¢¢E vû²È–ÁŠ#r–Íæý-%o¨Z@#™”Ì%@@än J®<%˜á蔧™PÉ4J²W„×᪑â´Ép̬ev %ÒA ô©hf@ ÀuÝYBš¥|H+Ù"Ÿ›¤!a®Åºâm-»4¥@ 2¿]ðÒñ†–&RkÙr•¨4öí˜hm\Š>ìB•ü@éÓcmÐ~'%^jáSµ^Ø’}¦ùoSš–QõKv¡G–¡ž‡ýÖŸiðqÍ“É—èÞNµR¬°óaÖ{Èÿ±ˆ|#ý‘Êe¨œp»/°òŻק Ôû?BŠ(ÌYg'–Î@À-¦oj‹@Ô6öQ™<Û#9&–äFÄ×}†CfÎ%ÒHì:’rB˜î°¤§z |ð™ŽVI©gxuÄÉDT%†•5® ¡ •i2Õ¡Fã-Å?Pk”6¾¯ÿÖáš„¾Zx­ÀÈ“¤Mõ™eW•š‹OòU3><©×mœé1ÚêÚ„òÁ<²Ãè$˜“vQSµJñʈ0l'‹›ólº<…ÄZs©ÅYkÈÚâ|2üs5»À/nI%ÛÌ!Y8úHÔ½Xžÿ,$Û(ÃvC§XÛ4v2:VfdŽ%$sX”–£ í&p=Tu½NîûK³…˜˜#2©­ ž$nFÑ.ŒU½ºâCh[Q^›øàµ\wùw>øwCDŠûäm-П² {dÀ´r扊 êKP¿,–Ñ°$ÈÐR’V€zV£éÈλڎ5'âÚƒæq½&ú&X?è™®ˆU<Ò8A?©<ÈPâK:¦·š¯§\^³*ǧEmlŸ4§·ºÔäz£‹ÉSË °¼¸rC‹GàIà=J„ãOÚæLe ™ ˆV¼¹mVIYþ;ˆxÊ˸àëþÄ <4ÂÉæ„»,ãÕ˜•?äš ‘¥‰B4±ýKÓ†w¾]²;[fë$bãÓPx¢Óz{žJ˜ÚG'¡¯|;„X_¹}ëÓ¦@ÚB¬I#PœCÀQ±ÃR‰†F`Ò¦•:d“°E¥‹g’WáÁK"R¼èi±ðÈ/¹QÊCoq<Œ‘ÅF~¢¢§êÈ’;Љ'±¸”‡ qã„) ãÛS˜äA®EW™@´©¨£wÜäínÊ÷z’8ßã^»dIZ%¨®€ú‹ÄÔW½vû²4S")¤ÞÃo¡ ‘†7–ïn®z¡fû°J6Ê=ëonšöö'T #R lÎNƒÆ™ )·ûû~NT‰J´€[â®HÆÃ!Ñ4òìú…•íìöŸ égsW+Ê…ÒŸ¡ë•äŠgA¾i‘üÉóDvMcõ‡XÒf$¸z”4KxÏ\Ù.‡ùµ¬I¨5† æ[;ùÒ #û(‘½Bʧ!,¸eœLŽSäS»ºHÝçkß«›)f8ÙiÉЊRÉr"r!AÝæ“yv-jþ;2Xâ¶Ô$¹)ÌÅéJŒfä fDIvƒ ý;±õ…ݲüo•¨ßàAñSØPåƒuBr`A;+ Ó“¬›U´b$¯~'‰ðÿ:áÙ}è—žk‹!æÏõFu7!UèIvWû; Œ™/m´÷ éõ{¯Jrªà–à(¬Gù<±ֶ䫡å5…Ì—¼×1–Ûsq#¸ë‚V cQ­Æ}&â⺅l¦slÉP¤±.|ñø¢`w %¸™ìî¥^1¼rÇ:°ØÓ¢… Ë  EN×Q×d•V+—3óp2;7¡®õÃáƒÍ|B9'¾]×nâÕìi‘ƒ1±¾Á¡+Ìšò§ìåRˆ­›A<öM/¼ÇõÍzIm[6‘¦Ú]ËHnÃoîÿ—!Ae¹ä¥mæ[¸|¹kj9w<Ñ_JìYf…?x„ìËÇ~8%Œ˜änëËÝ/QÒô­cTf­EœÐD@>”<ƒ2/n%Ðáˆ1R·ä“é÷ÖÖLdU¸ˆY´p©¡ýä” }ÇÅ“•–±;îûÛÈ®ÙVÚÔCÄW„U$*~ì´D°™M‘âæÊÛH+ >µôʪoÔD(QGmÃo‘¥q=¤²–DŽ+å Ê€ñæ=8rË @è×;=X×™4­CO»6÷<‹£®È>|%ɪv9¥Ia+Ûó]C°Ô rFA‚–Û„œiB6>ÕÂHLbz·³RQñ‘—PSÓîÈHì˜Ó 1.epîV) S°õ¨¯JŒ‰)¢NÈv^êH8T¡Çbã!løíNÔzŒ qp@j{ôÄI<Rw‰Ñ¶§_£ I-zŽ ôĶÔPšì?†(l­XÜöÄ‚TU.Kwb9 Þ†§ä1F̿˺Di È-¿Ó þöQÉT·ñ÷lÇË›‡“n,\Ë1ÓôÀ_Ö”™foµ#Ô·Ëášùf$îç 2+c@#°ÈîÌPL 28|#·Ó…ø@^|q¶;"¢ QÉqu`› x ,ÀµÞ¡ +~Ê…ð¦˜)WÛÍpÒ¬PŠ–øWnßícEJ³]\úÊFK¨ ­[c¿^Ý2,‡$•ºøû ²AŠÔYªÍOÆÙnÖÀ‚>gÇ"¥Ã­GÏîÃA[©4c÷cJE®„žÀSbˆ"£,¹6 ¨ð®õöÃH Dò 0âè߮—TîÃQ±Ie–[_Óౡb9àµHö#¸äšžé†‡®¬^ÜÑG 2á#…—’³»Oõ¨~ÖF@Òb7ØRX²š Kr’«ZÃqÄ\Y¡"ïÝrBW²8h­½ˆÆöW)*Röš¢ +)£.ÿµ‘ Ø-TêÚƒÃ~“|nåZIŽjÈ¿ë'Èð­ÙCGx©gpƒéê–¿h1¨ùS o¿$‚™Ñ‹)!…j{å„5Zö˜Hœ˜T¨ ¤m°I mè$T|A€¨Û~¹"PyW.£Ð0˜ØµiS¿Èdl0ʱ7,¤rðÞ´É ”›*‹rc„´u¨,?ÊROÙÝ@á/·vÒ†ø° ”]¶qFZ”< ­¬2‰!ƒRÄõlim¥kÒØ’ˆ]@-æSШ`ß©r2Ê#…BÃSŽßPkKÔ„·! 4­+ÇjááÙ[µ5Ìåyó<çÙÈ;•"„»ˆ wÉwæû½ÏI”†‚ÉÙ ø@aQJ:í‘ð÷»Iª¤R°¨`x©]·ÉÇà™5Ìm£-¿§x娔 Hh»‚|2$$U"ôA¬äµ¹·¤3Û‰e %‹!5ê0IbK[ÓEa¨ÏìϦHi–‘3Ùjö7/Uk&I¾F`1úðK“6÷¤ô$²†e¸¶Tõ—TW¥¹Ì ÝÍO2¹Ñ5©µû›kxX´ò# € »àfÆb·q$etæ»k­YK:¼±4<„f@hUvoÚß-‰¨‚—#!4m ¿¿¶îgZ>~ø–V¨"%K€`ºæÂ[ò-€ ¯cß (­·\G^ß×#l„{–ó “×°>@FëK“±Ú¿ç\xC M6ÎÌ7ê6ßÛÃd%*FiÚ•ÖwÌtoO¬n9FÀŠÃß"a|—}Óø<ѦMëÓmíýt$´g(>Ñ^µ¯|¨Â@slf««ÌËæ•n’ÊÀ¥ä@…4QB”ÓàøÛ!9ˆÑh2Í;INJÞš¨ÛˆëJ{œÀɨ%͆ž#›"‚%@V´f-Û”"ɼ21øG‡|*m5·†5ì0ÛGÆÄmM»œiQ # x¹!LIDÇ<‡¡ØvÆ”a+ñÜŠv»/Y‡p+Û»/ä_«ò‚±” ï†Ñ¦Ñû|±µ1µ6J|½úá¶4¤ÜFÔ¯Ž%(w M«ßõdñ}A„ÃÿÐã7^RÔN™g$ð"JR´Õœ«UÇ(þÐ`¹›ŒŠºòw°6Jµ¹ÕM´Ä‘%º˜ùÇ¿64%ÏÐre€·w-,¥©Áß© µ0‚(lœù{P´I"µ»ˆËNÒšl\ðâª?ÉÈÎú25ºOqs#™ê»ÌÕ,w`V•ÁÂP) Ë—mÇà0¦›"§ í*62êH}p‡Ó4âÛÒ§`6ÉÛ N“ ¿+]éÈ­¨§ÕÄ‘ú±óÛ"´_}ðŠA‘<”g¼4}êIäŽév©€+OØåfDšèÚ »Ý)y^G Ƨe¯²ŠcA$4AP=ņ4¾2•bW‘¡ï^Ç-$+ýJoª½ÑBbR—AVß%Mwº½Å½´zU¬‹)k§–a8NÊ(éïíÛL†Ùbà?6”vQ@Ÿ?‹ýÀ¢`U‘†õ¯/ôÉoÕ‰rW‰#U&E,ʼéÓí²`†Õ´»¸í®„†€üAj7R+ó9s:Ûu’]Eõ¢J3U­HÃtÇ‚Ðóʲro8ýmDiDP¿ù“•ßFÎ…ïÛ¦¸WíóØíR.ÝÄJí_á­[ªÕ¡Þ½>}pP]öAåþtÆ‘jö°½ZÒ&p=×q†‘×f¤¡n,@5ROú¿ÇeVµd(j*(F-JË,‹'Ùi«×cÄïøà¥â¾¡6[KýBKICVIâ–.{*ð¶N-¹ÛáL€WÔPrJŸW†7“’Ŭ`œ‡/»—\4Ëj¤}µ“]» V7— ’AàèÊ¢÷¯5Çf¾Ô3No^C”2I%j¡@âH÷\[(Ê7¬²µ7J•ZìOûY-©zµqg$ш%(*»‚C>üFèÙ0òö¯e¥Ïz÷V‹v.l䶋˜¯¤ò/Ã*ÿ”23‰<ŠaÃÔ'Sy›AÔ– +˜äÓtáh±Íõ@¤¼Š2‰1 ÑYM$§ÚÈxr³<‚§ëß—×^Y˜]XÛþ“Ó¡FƒÕRž« GÂ*ÕaË)‘˜“dq@ÇÍ«Zyv[2˜´¨a¹·³‚m7ê÷ Ñ£;Žl)öý—$ šåŽ#½<Ÿå½KKÑu-IâM¶®Žµú¼æŠ>aŽHä£D15±Cy§òú]«Ct·1údÉ"ƒÄH´+·_ÙÉcÉIJ‰VŸëV”û²æ¿zø ’F ‚¯Ý{íŽì….`Ì6®Ç§ÓLvSezÖ®£ác³–%Fè‹a p³±PÄu»œ‰dS#¦Ælášäf’ýšÔ ä¬î’M|­¢Ã{¨=µÔ¼aŽ ^'‘Àì®S–3±ŒlìS?ðÔš%–¤š¤EVk46Çfýô«0ñèÄrÈœ€òLq‘Ï“•Ê]5O® xðåÒ¿êœ1âaòÞ·¡\NºtÈú2²Ê5ph¿g1'ÍÊŒAJõ6i Ù,4SYÌéÍ‚#Z£]öø°Æ H =½Ó$¶Òà*‘2ºòR*G4¨Û±Ë#ŠŽË) ݆“™_‚¡R(î§m‡ù9’㊽šXAŒñ;ÓèÁï¡Ð¶„„lOÂDZJ#ï_4“POa×·\%hŽG? •6ÉS*]õ ºqôØž0HöBH¨t+×n¦›m¶(Ž¬ªE¥ùy¾»\H‘ƒ9}Õ…w ‰ÍÈ£Á”‹,Ó´ÿ-ÙÉgrì²Éi$íÚ"é,NÄ©äÆ‚‚³YÏG `ïCk6>\¿-¬žÉgIâ"¤¾üY:QNF9HæÊXDœè ‘4QÜÌñȼx8A¥ GüG'âŽtÇ×z,P „·zµß¨F†£'yŽ„m‘ñ韅}W,ÅJ«Èµ%ˆNõÛ#Ö’B#YÐ%±·´”‘ûÄ- V¯mÀ4éðÓEHsIŒ³–HØ øãl„ìîOÂiQÒ0“¸I sg>Zü°»Ôඞæá-Rç‘£Ö¡TTÁS!<¢,De.I¿š<ÀšN©m¤é’Å&…méNj§›Æ OsÈf?×»xÛf+çß9_ù›V[©è¤A`MUMÙÚË1À6m‹ž]:Ò§-G&¿¦/–Ey*¢ŠèÒV¶tT—äÅGb¤pZ”]¤¯*GêoÍE{WqOzb)5aQàŠM5îC;„>šÒž mLZµœÄÅÚ?R;…e©Üð Ž2@ßš7X–ðÞ=ôФk¨I  •â(Ùéˆ÷±;'^DÑt±+Üj=K+¢°Õ}U ª‚ý¶¸.Fs®LÆ# —ùªÒÊÏW™£—šÎèËPH˜nŽí…#•2QÉ·&žÊÐvšœËéY4ÊÖR]VUîQcâädIn„vIï®L×RËÐ<ŒËô““!H€zT¿ëÆÒbŠ»³ã4ê$GôB±hÍT‚O¾ ëÐ;mÊ@}€;dO4Õ Ç'q_Sƹ;^KÎÎÄ «ãÞ¹M[‹šžõ8 Ûf‡nþ87H®Šk¿L7hÙܶ§LQKöáP~ÍH)” ©†¶`W É=Fæ¸Ò½½Û[4ŒýìM¯§ñ»/z謮®bº¸¥!µâf”öæB¯ã–÷±”€èª²[Á(ž(ªª©è¬”nN:’:¯ÙÂcHÚ_0y“Q¶ÔZà%Í´Ñ©¹f‰RJJmör"½”¤;m=Ÿè¾:O WT’>9ÜQ“ýD_‹+˜ ¦;Ži"£Kµ+E ze±¦f>R¿‡üMåkNE†×N lÄ6NEy“þ¿S•Ê-°6B6ôˆ´}dʈפðYÜ +òõ-\~ed‘A|fùµ­Åå5Xm"iÕ.÷C‰j¸<Óá>›}–³’ŒÊ:äwK [ewbÚ”RÚ”Šu„³Ê„)"«ÅOû,yî¢ÉDÚu³ÛÜ\C0…–5vI BvþR:.X%Þ×ÂRèŒbÉçþëÞŸ:áâG %OŽ&ºHÛÃì•™àu²&ÆáŒKÍ£¡H?:Œ“`FÛêÌÅvâ8à%‘‘?zkJ‚ßG|x—€tGk¦,kõXåIj€Ü«µw§DbIæ—XBò‰¬éz`û‘_¸`"ÒeA˜ùoÊpzP\jw+nĉŻS K;~Í~Ê® d¡HK~ŒƒÌ¾p‚Åc–ÒÐ!u‚7ª‚Ì´çÄvPvÊ,îÊRî`ž^ŠÎöYšýÀŠ%Oƒ•êÀ‡³™d‰ˆÙ0Æ%̲«çü°Ôt˹MµÆ‹whžŒ*O«êÌŸk¥½²±’`î²Àñ—úf1©yJ(´û{‹øoæ1µÍâDJˆP(*§˜^N•rÁ–ÑÂcÍŽzlBíö÷_Û,T vQV›¦HR7æàxì«ÐP’wÿ=ò*º2î h+Pó ” @“"˜išuÆ£w˜ýÚ!c#ï@§ö©‘‘¥Y¦yN4ÖÂØ4£ÒNRžìê&¡5n5 FåEl×Ã@;d£»VK`Š²Ë¿ S܃A„€9¨‘(» Ëæ’%c ÀHŒáWq±ëÒ¹zD*oZŠÚ=JK{vå µ¥@©íZábE ÅÜÁQÊsb<)‘5m‘äç’v‚8ØÒ(‰£mØÔ䩉!|Hé#lÄô>%TÂÁ[!#9'Ó’¬¬|FßvGr¤*Áé´„[¢©§*lÄ|²œfS.Ëèß-ˤW°šM£ù¸õ?kör³]9²#½­i6 v¶ÐÂl®‘y8Na\±ªð­vâØa>ö2É*Ö4étÏÝ3sj-ÜÕý’乬eÞ–ÇI&Uc@Ýq ¦Kø3Èhµ÷ÿo"RX!2é³ú¬¿Qµ“ૃàÊüÑúL:EëiâGæÒï{)r+¿Í8ä$iH°È•í§õÍ̲Ãeh÷q¼ÁUÃ) P>¥><(``n­½©hV`yf`;åÑ݉ ´^^Ãs‰ ¢UÓÓi±¢šcÛÙ)ºiÒ[Eò¡0ÜÆïk'óÚÿL´n–'KI]Ñ–˜æŽ%QQÌ¥*ÃùwØädÈ£i’­Å¬×8å4N+ÉW±ÄÌ1]¯ÑÖÜÞEˆ"ˆ@jOoxå^#w†ø4›5*â²Ü… §!ß"r á”KºÂ«RKu$×#,‡½œqŠäˆ0°¨ñ¦C‰•Zôµ–´¨;oLxÙy¯K Nä1'­®DÈ(欚s×qÇÜâd®šü·#ƃ!Æ’£ÒYº¿A‰(Á‡%(G;uÈŒÆ4Lz:€vû!oÑð ÝH#Ú™-ÙÐh,cìÇ°îw߀A_Ê„|;´leµ¤z» ˉæV&§­qÙ‘¾æ¹a^TÄ´a  ×sÐœJwhÆ)³m߆@÷)¸Iø»tÁiCÈ¢›=Nô§ñÅ6PÌŽËÄýⶤ֮E}øvbV}Oöy|IO ÓdA& õÈ„[õf]ƒü÷ðZ·‘OˆŠo\Y];÷† ®ã¿l;1µËQÖ£ÛÇ ¤…ÃÕ®Õùð)Ø/D¸´k’¶ú¯3̦”5®Ø²49ªÇu9Œ+âpûÑa].e#ââ{aÙVÛ0&¬!uZG¥9$]/^Hj¬ùäv(•þU?¿ûX8Rd‰‹TR*GjõÛ‰X›V[ØÛö®$27ê#Ï4‰D JòØo€”ŠhHCuë¾<)µ­r⢽úá^:wÖ‚;uùd¢7 Á²ÿÿÓâ ¦\jKËsëK,þŸ$²ÆŸÚ=UGÚÍŒ8@ªu{óòH.V’•­S‘àÞ t8lŠ›p¦Âž?v"“º´Vs¿¥û³ûáXÉý¡Zmˆ‚ ©õ·´…`ˆ…‘ªÒ¿R;’Q¾éÇ›5i’c`!Š?KÓê\‰s•†bÊX»úÄ‘1•™ ÈŠÇc±ðÉE¬Ä‚„XÓŒF6TšI¡'áEml2d6N-<Ýom§ 2m.ÒòÜHd–yú²HNòrí·Â£*” ÞÙŽå;íb-NâW³¥>r5¹€TZ"«òpÆ=ê|’Ë;Ä·‘^h}`UI¡ó96< ©™ãç+(ø[‰ |A®Xˆ÷¬nRÈ\ è˜ÑM„ÆÊÊ™^A) ¿² ü.DƒÑAYžÿV†òôƒ ¯g B¡An2ñWü¬„®™Ä€™iþc±µ»µ¾·f »4n~ͪGE]ÿi˜6Vcµ6ƒ½‚›_yÕ&Òí¤•…Ê^Ã*Ã)Jz¶áwlPïü¹TcܹcÞóKGA:–¨ ¦2½754ë™5C“@i´lö3[Ï¿×ź8ˆ)z–cΠt+Ó5 Gšž¢š|~[Ó§Ua©4“ÇxÎNÀ7PŸ³ðàjk½-Ö®­äŠÆ foN~5nŠìÄü4Â{d*Kò$u 4ÉLy­"›Ó§âMq4¨Øƒ¸ÂEÒÿ´vÜÝÓɣѧ„k„.>O#Ö›W + ܩȞ¬²FÅÙ‚x(ß®cA´ÓnÞ™c&9O5êEOð8“håºá§Î&XÖI=ä/]½²,̬/†ÂV²kÚR'?ãÈ ,D“ýËó\Y-ì¤ÁrÉF5«"Ddr?Öû5ÈHÑ¥ò]y—4¨!2Fú´S+5´É'¢ªZ„£ɾw,¨u´¯J’™ã³Dï3HÒеFE6ßrÁ"p–¼#PŠSñÃvÄF”˜–'cµ.ØìÍ0¶ÒÌ‘¬³È!Œ£?ÅÔà>y"Âзz|M>šÖ½ÉëÓ¶F™7ó`ŒhMwí_BHÙë+N µËÃ|•¢Ù,ýºÄ*Éû¦Z­i sàWcL²÷¢-.Í­Èæ Æ’óôŽà†ØŒ‰-‚4˜é6¶÷£™=$‰yKÇ©»|”dl/¨{™UÅź®Ÿk{pËÊòÜŠs&ÜH㙧ÅÉ”¦UÖÙžL*#Æ#%”;×—ÅMÿ$åÂËOlú|ï{.JT  {’?V@͘…*ǧ Ù˜ Ó¦$Ò%, âíCÓ"fY«%´dé€C×J8B©¶ ŸNÔÄI4¢[£zÓ¯µ0ZmrØ*îÛŒxbB!-âQörÉ>Ê€;øà)¾dMð¡¢ïZV§îh$’´³u¯Ìiú•29§ß’Æ-q5'#lÀZÊM©Ôœm*DïJvÜõÀR³˜ ý-"%NI¹ üú᥵'uë_lˆeAL·#×XܲC½€øÓa¶RÓÌКWæ¶[ÅŽÁi¾!­’kºìw¨ÛA-znFç¿¿¾NÔå¶%©Më¹í‰X•Ai]éÜ×S^æþªÕßîÃLB²Ù¥:}ø@]•’Ñ:•ùŒP¬¶ÑôáO J9*­¤,#'Ã~¸¤ª-íÀ¡Œ ·8‹A ‹ ¥)èúü±²šÖÁ‡÷d};a+¦tëÒ£¿N˜D‹4˜ Ye#ØŽ˜FF'¡ßMã°FLNÑÃ\ÔšÆMÕ ýÇÞ¼]Í­Ú…‡l})ª½_ØV[+Zêp)é•>ÃlxTÈ/[æJß ‰*¬±9û^;Uy}ž˜bwgmÿÔäámrð-¥ˆÓ—L´ø”1A·Ù  ¥”ô̼B#ˆºùˆóƒ ‘•·©ØÐÀ”Ë&B׬RE{žØˆžHâÓÍ=¾®‚iA¬*RëF"ýÎO†šÌì u ZËÊ-ø/ÄGJ nqÑ t*&ÝVÖ ðWf þ,žÙmœŽË\Mrc‰~7PwÜœ)âB³ñªƒµi\‹0-h4÷ɦÐÏAíï‘!WTÔv˜ ¢¬í.¯®DÑ™%ü*4ÀìŸØèÁcõ¹c.óÅ!Ž ➧¦ÒS¶õ \‰+E8¼²‚úÂtø)]Ö_äÁ&b~–ä0¾ë!¶Å æ©îaô­LVXÀ TÄ1ê;V›cfÙ¿]µk(ôÈ”nÖ‰<ä®à’AðÂNìH#“Z­¨É42±vž¿Y”„| …§ùMZcÂì…–IÕ­ôG´³X§¸‰DÉ"€K™ÀTõ<2±+)”h'÷Z´žUÐm$‡€¾…`·˜ÑAôÐòu¯~¿VcgfCaºMþW»ÒÛWÕl…õã\\Ýpø‡«êž1¤Œ:,_j‹’@Ò8óµ¶þOÐgŠi¬îmÚìÚM¸9J'×V +F;à0Ý)ˆèȯ4c|ïd 앯Âë^£ßl”f L G4²~Y7âPò°ËiªÈJ ˆä”ø‡pßæ2Sxf^Lòå­ûêSz±JŠž”)Ç—÷£í€~˧ìåYr˜ÂÓ4Z +u†%k׎#©qÁ8­#!8t‰w¢Ðw4®U)³½šHSV#éùãÆUE£P&¨)ƒ‰*&Ÿ!Ü» Kº¼V >ЮFÕ Q°Q÷ci¥âíÛ°Áº*›¯-𔀬`dAZ6ØQJQøaMº‹Ûj}ø ˆ»®VÌ©»¯l) ,f5ßé#hÖžÇ#lÄT÷ÜPïß !xJÒö÷Ái B:Šõp¨ LyToZuÁa•(õðÈaa¨4Þ½1´8¨ûch.•¨ëÛM2.ÛP×®E6²‚»Þ' ‚¾µÞ‡n¸ÑI ·¹i¿¾,}ÎPµ‡¸iJþ òÃjå ÛaÜ`µáTUBµëàp°ê¹IE +âmèEÉÄ+"&Ý\ vV’h¤Ó°ÀTÄmñŽƒ¯lBòQo„Ó·¶Jí!ÁëÞƒ¶ CE÷ù÷ÂÚåâj0ÅcîzmÞ˜bQ*+Ó÷äíˆÓ |Jp ¤Ç¹`”r¿|,hÉ+SJŽØ‚“‡‰4+׿¾JÑÂÑUãPµ=»àµá^$©Ø|#¶KÔ-ºÿÕâm&¥<ºÃ‰ã²Îlùò.Ëð…ŒþÖecá»…ÃÝ°c‘Z»H ž(zWß2ÄK ¤ÊÂÚæmBrÜÛ~+»~ ¸ûšÅI[W†e¸'ÔeI)F¯ô¦G‹dCsTšjšRiÖUŽ’Ìüc,>Èä¥ÜoÔ ¨K‰²Páb<å`‰* ióë…žÊè&JÜDÜYT†qÚ»dˆ0ã£HOH…©Ø×ìž¹ mâwN@í‚ÑnÚ m)…–—uw’Ë ÃÛ‚ò5ðÛjœ©è–º}»ÞM/Z4·&^œò2&ôø‡ÃZe9¤z6âá<Ó9,.µ=GPŽÒ––Úz„“ÓêËy¾U9@æÏ%+="õt-5 Å%¾œ—V#ï^ãà8dE¬IÙ!ó _k}h¬Kr\¡¥j–¡‚ªÿ² \–Û"@„×á…¡—TšP­)[xlѹH´E<š¿e d… ÚCa¬ÝÙÅu L W‘ˆ§Vªßvf%µ2)ZÉs2Iõج¡Y#ˆÉ7ÄÅSâ`‹íŒè"U'³^—Tw¿)n%”ñŽZ·%ŽÛ ñš‘"y¢ì|ß¡Áäøt·µ¬²Bc2¡£åRÛ÷#"A2°Èð‘E+Òõ¯,Y]½ì‘Mq?ÖêñK¸[}Ã1m¿zNJDò¦1½$ó-ÿ×µIeYD°‚} +\O‰¦ù( A;¥ñLÑÍ Âb§¡âk¾+C›¦w’áÜ­=BX€6ßo¿Ôâ丢î w铉¤úÝôÄÒn –öOZ†Hbð.|{vʤwäÚ$H«Kf»•Ý¸Š²qbCTþÐö§L•Û²©Õb!‹Åõ‰‚ZRHS( M„ÓÊÌ׺áã´vòNÄlK-;àŸr`hÚ¦‹p&×íœÍ$¼ý0Îç“E.ÿ±µ0l“’Êkæ«ûÝPYÙÛ1ô/$)»ÉËj[‰º~ÎC¢¹$Xþ³¢Ia CE–:ªRÂDÙÁÿ0ørÞ;aT”Z$M)i؈©ñPoMºdÁFÇš/QkÜl¤,Œç†ÜOÙ ¿ÚñÉK KÏPkö«ãô`UåÜx¯ò}é¥QözÖ»áO©+U'ã<(öðʼns(iˆz#çMÿÒväÏ|½§­Ú¤S¨ab´ C8“ÕcÁPoþ¶S`Â$C»ShíªVT$q"™–2>i|O¥;qûM_jý¹ nèŒÐõ½OG¹i4ç§?ÖZŠšÚãÐä' Ê9)‘ù›ÌϪ麕‘#Ò)7ûHÈ:0é\ÆŽ26o3 nöî 2BWý.KÙfI)BVCV —DµÊº "!+J“ZâpØ`Sû//Þά1¼A&S±45\²q’Xyv8¨È…¤"Œçjý“=¶Æ4Él´Ù•*bÝ°Ìs7"!4·Ð£ûsÉ×z ¬Í²"Ññi¶Š£Šî|r!eá#-¢@Áh Œ‹(€‰™‘‰Ol¬Û K€cS–ÓUªFŽ!v?}{â…TYZ—¾6›µE^"pÔRð+ï‚×…®”ìqÜ ¸¹Ã¢N«xàdâ{Ž˜n¹¢­£¸?«*6Rz·í€$ÓŠïA½:`eMn+Ülȹ-gÚ•ùa¦ÞËK€:oß6Ì Rf­k÷b¶§ñ1"¿NØÒ’B“-òÄ¢íiFéáØäSk£r70%ej={Œ ¸–†4xá$¤åƤì¿ç¾©^®)ð×KEªkÐW|A^ PPü[mÓ .›R§jn0¡Æ›`VÀ…Lm$ZãÄ×qAá’¶5Jˆ¡Ý ® ß ïNøI`"Ý ?Ç®E°y¢‚ÕWì¯ (5ÑtSÄÆŽ@Ø…qãî1¦([•âÛWM¨€zW AiLšåÜž˜ ·&”¦†¾W­ªô¦Ë^šÖ£ Ò+vxô¨ÿ>¸‰ZNË'%md¸©ÛåÛ¤–•O!à{dñPDùlÿÿÖó´n†±Û²\±_IÙ¾Êñl{ŸÍÇôŠpeÌÙDZسÜu“ˆæÕíNŸŽ^i9Ï.,Ïy,©(ȶÁyíË߈® œ–&¤÷7N%xd&âf•Y™úÿ¶r°Ú8ßêš±·aȉd` Sb¡H~Ê€D&SÛt ZÈêü ©£Aö™›âú6Ë ˜ˆõCúð¬70©â¥¯ùMȀˠHŽà”¸“ýoÚcßl‰,À¥/åÅ’¤(^UQ½vùch/Bò#éé§Ka:ÒKÊ´·²Ä¬ɨ¿Q’Föf1‚<ÑêºE·–çãÊClÊÕ¢JzqÅšYcQE®‹"àó´óK ¥™Š –µ†âè„¥«ÕÙÉG«Î%túœ·²¼V71-̺™x“—!UGì2ò" –Â$91+Ö¸gÓî¤F•3MWÙœÈC4cöW-é³OûÚÍ8Ôf…åæ_V›T nGz ˆ;$Ò¨4´¤žž=òuktËü·å+­BÛL’t‘l®§‘šXéöQN»s¨Ę̂²15²×QÐì!º¶¼´–íšiÍ»–àŠ „V+ûD0ø°ÈK£ðžgv¬£ÑË"Yã’MAî : • €ùTß'fؘŠæ[›/B–Å ÀÈîÌÇâB´Q±Û\”‰@ˆê”3+5)Äxu§ŽF›rzr?­Ó EbSñÉ°âV°»{˜®ãgô(åu5Zoì¹#ÉZ{Vifeå%oS@6ÊÀd¢¬9(+PI¨ÀC>«…vðo;b€·a^äu#$X„ÇEÔfµ™ÄncŽQÆB (ê•ðnø+½2Ò*u»G€*ËCj;žÃ|eT±‘=6bUuÝEŒ±ÛË$œÜ– `xª2í²H$îÅuÍqµ+–d·Š¢!x’MYº’kß%ÒJOH²¯P[æzäÉbRDªÂ†„Š­1%®UZroµZøPâ‹Ý`Š‹·aò9m>•­ßß®\€4’‹V"²§ V¤ô;R™3ɨìƒëÖ"È_4©õÔ3F ¶cm®¼’ÝB÷Q‘f¹ÈÛðfê;Ðœ”vÙeeA(¦£¡­ÚË8©†èˆY"<8,öä bdÇ„ÛKÍÌå4¤–©­{ý9IÛ›$S7Ê7³. E4bƒ®W,àrQŠD³-+ËvJ=8—Ô=\üG0òg‘r¡‚#šu”*kÀTm¶R&[¸B2Eû+_ó8.ÒL`â(X•ðzuÈeÍ“´U¯Ìd)7²ïÞ>ÆŠ;Ól*9.^J(>ÿíÄî€kˆî1$/^4§êÉ ^‘þ}p )9FÀÓ®M–=«‚Û(tj´­M|0¢œOJoNø‚–ª*)†Õ²~µê6ÆÑKH^”®5Ó¦ûm€¦4êµãJ×ðÆ™¦i×}·$àM¬!Óß ()¹Ÿãy,5; íß¾©tZÀ¿ 6=ðq/5:?}ÇùôĤ65Ø‚‚|• öÁ²mx"‡Ó;ü2VÆ›iÓ#ilÐôðÄ•¥ü¾-|k„ IÙY¦,¼@Zw o÷äIHŠ‰¾8vêÇvøÖ ïòþ˜ mCAˆ*@ J.ÃlÍOE'u¤oï]Æ)¦™€>5;ãvÄ…¼û×ç‚é"–ú†£Ç´Ššþ- ´«ûxŸé‘deܲ†ž8™ oÍnôø@ë¾#Õ—Z¾ÞØD‘¦b Ð}9²èµ*vö 5õz­GBǾ eAhµ^D“Eë\ĀطZ䩈+Ä1¢§ÇøàªM¹¢ ݽ6 Øh¢Sm»S °Ù°l:ûâÈ®@Û·\–êæÐJïÔûäSa¾Ù¾üGêî!jiS†Ø—ºQývÅ-€ö·êF+T×3Ò‚‡ ìؠ©Üÿ™8¨.ç¶â‡ÃÛ 4NÄxãLÂÚÔPmƒo×é=1FÍ7ÑŠh8wé‚’VÔ €©ðÇuªw 6Üá¦6Lz~¬PKŽÂµÚ@uG†ý° sZ òí–aúƒî ÿÐàz4ëW¶šL’*[— 7‰UENàW§ŽeÇhØpÄ^‹{b‡N‹N¶(y l&çïÁŽ–'¹‹~`Z,vÖäŽ,›'bG}°Å» =~&<~ÃiUî2ÆÊG\^ÚÏs ÙYð·„Õb$»µ7%Û¿Lš |×Þüv~¾Á®n¸Šj ¶’÷ ßâò÷Ȳ¦ÕîrM´Í6"\ê‹$v„’^ãtrh´ûTÄìΓ!}¦¥Äv‘õ6XÞqZ…<¹ð'¾Û`²á!­jɨ½õ¬ÄÇ7!ðUx«7Ùdâ6jÚÔ¦‚ce£?³µ**Bõ4뿾&]Éáù#_KµÕ5¹áÐãtµ&1 ÎËPK1bälõÙ$t©–±[Ím¨LiÇÖž& å¤T)鳋|‰—r€Ž÷ÊÍ©ÂÚç«eèzrÅf¨ê¡Žß´W‚|"y–ws—nè(¬~=èYÄKæ˜i¤ÚNeÕak‚”ãbj¡ê7äÝWìädODˆ‚7O—Κ‘ÜiZGèéP0ä’³}µâh­¶ã¸ÊLfy¶ò´·Vž HÜ\ÍY/ €„ž4aµOó|#$lƒw©ŸÑÒÚ ÎQŒÄ|j#Áì”=2Ãl’Ø[Š½zÓG¹é„”Ó\¶]ú÷1!*ïnÉ RHO§2—MëѸÿ "MdnÑhÔ#¡]÷ßcÈ{ãl©dhÜ——o›a¢íÝC3μšƒÛ|°«Ïwë[ÇhR²¡8mVf­ÐrJB`ÑrŠ…8?SÖ«ØÓæ+`Y$bc•7Ø`ˆe#HÉl‘l}bŦ2ñ@>Ï?Y'Ä 2{»ëIe²†ˆè¨¬Ê7@bWéÈ,ÁríGI×Î×S¼`Ñ\/§çÉþÌÕz¨ßÙ‰•ºO)ëq¥¼ñÃë}j$¸„By¸ŽJñfQ¸éƒŠÐMs+½+V±uÖò@òÈ$$ ŽÇ%{(6†1­v5­¡öÆÙup…÷ª¨ïCŠl4Ç·Ý1d'¶Ë¾&vØž#ñÉÆ4ÂFÖ*UAîNÀød‹ª".Ôè*9}9Q-œ)¦‘å»íF@Tq‡«HkøerÊO/DÐ|¹§éVêbZá‡Å; ¶þ̹¯“•‹ æSiÿ} X«À {Ÿ£w#Éœ ÷'°È’Ë„uGÇ ´` x㺀æîkÛ·¾$«&Ý1*7+ÀßËeEß Šâ)ßS ·ìÔŽŸ,wA¦Ø@¦ý°Úð‡H¡4¯M¿®Tz®k¾õ鄱¥@Rýx9%¡JoßLWA¹ùb]^žýpØP’IøŽÝ d"»aZÿϦD”ÒÑËaJÛ QÈ=(O†D\-¦4ªÒ½+Ó +EßQr7 5Èñ-4m@4ä¦hz`3d"¹­Ð— WÃ’HPxÐV¤µ@XPH½pq2 ×¶F⛊нr7L€µ6 Ð6þ˜‚« Ôí÷W ­)òmÁ¶ c]ëK½jv#¨wè»uh$ÅGz¸iArÃw×Ñsáðœ¼AÂÖøô·’ƒ°S’E…E²¾ ÿ£ÈñS‘²b°X_­·•sÀáMÓfÚð0¬<ý0ÙRAibº ýÓõéC„±æŽçŽñ0Úµ§õÄ2Sw+öþô$ÓIZR’â4Š(å€ÛïÂÄDô6»¥Cýíô+N£ÔZþ¼;$ãŸrŒ¾iòü_Þj(;ò2 oòÄ d1K¨CŸ=yP§T‚µ§Úñ÷ÉW’"é|íåD$6© GZ%N"V'ü­!`º”D äMv¦r<)*/›<¼ô+¨DÕéñø)þ)òÿÃ[耳Vî1¢£\ÞeÑAcõÈè»·Ä7ï„“€![Î~\PI½B{Ò¸ð ã+O4\+¨4b;}N4ˆ·œü¾à2Ý-¸D•§ÎÞ[Wã%⯉$vÉp§Ã-?ž|¬ˆ_ëé@H÷Èð¶xe1ü¢†ôV•;aà=Ì|1|ÂÁùŸäêoê(œ|)w)Œ{Ãò²< wúÿ@dצJ•‘Áy¿ÿÑâ¾Hº–ÙæV$-3NAæW¯öé™ph‘ÑœÚêæoUÊs ¬´ªGlƒ̼ÛÌÚÓj—>¶äPŽ'µôË¢ wgv>í·¶O‰¶“ 5.Ri Qóx£fzšq©?vi„‚ÌÌU좠 ÷êOã€H¨½8E’ÈL€3MvÛ $1â6­}pÒ¥-ꨈ‚6»*ÛŽ@Uhve¨1¯ ~§Ç%Ä¡õvŠ%W!Y‘dBz0n”Èñ0 Þ—¤ßêW°ÚZ©’V«*ø¨;Ÿl¤Êdõˆn-¯ž‚ZXš’“݆Ûá'm˜c’mZòKW¶ 2Ò€7b¿g‘ÈómC©øE§ß€î›¥ÊZ«üêAúk€kŒìÓ4®ååbC1߯¾X("‰dú›c¨ëQZÚN ¶ò´ÆXÏîéO…|\~Ãd%6#òNôÏ'ywW–ñ"ÕD k"ÇopB¨z±"’8º·†Tr×6c º0òZL—QÛ]Û]Ê…ã³T~/)^»¶ÿg–>*œRÃÕ<»«é$ýrÚHã-ÄHTñ仑^•`!‡Dº‚¢§` a%•”PŠYíQˆ,#<vª]¿ L¬¬M£/|m䈲¶¸º±¨co+Ö‚‹«œ°K½ …î‘5–aw'{âÜ"ý°«AW«ZŒxÁ^—)’+ˆä­ ?]ª;äl2Ü5 ZƒÈ±êÕêXÎGd’QofÒLŒcn ˆÀWvï ÊÓ¸V4ê7,VÉëS©y9-Ûjà”ÑÚKÙ"ÕîQT0…½FmÉS7%h ²&LÀòO¯à•c½±*I²·‚T‘Nõ¹U _È€ deµ!|¿æ›0L¡I¥·[Hfÿ}Å;ý9cîk†]Ò½{S{«÷F‘¦Hˆôå•‹0@¾M@ÃÑI'ªë+×¾¹¤Ks"ÂYÞZŽF7§JSú¸[ ô7²[®³ul¢ÛQi–-Ó™cðP}š.@6DŽêI´˜Ò+æ2Y­ï§ŒÐ?.<Ÿá¡ª}¬•–5¿zi•5>ÛÚ˜žâáVZ Ö)ÂjvÛˆ‘è‚Õí¢:Ã[EY¥‹÷(9Æ8ü4ý°Y´ãEò¯­t9Aáû"™VMVÔa‚Í–aiqF"J( f¦K•`#9lµcØd œ‚>R5®Ü»öÈY@¤HÙ~ÿ<6ʭʇ©5§|H¢ª«Ú1´_z¢ûvÆÒ†¡þ-“|‰ùwÅpâEk_§Qh™˜6ï¹À¡XÁÄ×j÷±´ÑrB O_!U'·â§ÏåŠJ€*M+‚ÙS[tèGlV©ºí¹'+`´Ì´§qÓ’î^Õ©¡m_qÓ®ÿ<)6Ñ$šZô ß‚ª‘\; îOe ÄýäÈw«&ŸªHh¶W’·”ýßA‡Õ–<Ñ;q‹D¼r"dAûåddòYglŽ‡È¾y‘j4b%¸…~î%ò•›Wæ<Š-ÿ-¼Ö!\K§Y¯q4òmô„ãøàð ~¢ Ù³–ÑAËå+{SMCÍ:E­wø\¹ÿ†dÈ‘Žþ¸·G¤î1Ÿ”¿RX¿,í7þy¶ØЈPm·|ãþwû3ü® ÿÜ ÚÇäu´5Ç›%˜!£ÀR~CÉqc¿ãÿJ§GŸ¾?0ƒ›ÏÿóÑmZú榜 ¢‹„ðôŒþÅüžN²„ÎKï¿9?çlâ-kiy{0ûìê§æCtÁÀO(Kæ‘‚¹äŠ]üä?äÄA‹ùbId¯ÁÂGãO~g&1Où¿ìšÎ8'#ÎHpQ(oú_Ì@…c‚Í èÂ&Ÿ«ÑõññuÚ—Ëÿ9Kù¢ÎY'¶¥8À¾Œ#B;ÊËUûRÛÏùÈÏÍK©½WÕ8÷â± kÐ —äãÞXX¢w?Ÿ™“ÉÌêò)¥P-°RuŸÑ+Î?ÌIÅX˜òM2CK?›=ÑK'üÂóœÆ¯«\W®ÎGêÉ~^Ì5>”¡7¼×0¤š¥ÃõÎËù'Y“ðRëºÌ´õ/fjt«±þ9/ =Ì?3“½Eµ öÙ®$ õ«Ÿë‡Ãs}åHË)5.I=I'%Âœ’ï-b(I#ÃA‘=VábìUºœVÛá#éÁL¸{‹¹êÇïÆ‚ñöýYœýç¼rïkÔ“ùßã=í‰eï±ÜãAxÏ{\ßùß#ˆ´YRN^"íÎ(·Pâ­b­â¯ÿÙcl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/puzzle.cl000066400000000000000000001131561133377100500250110ustar00rootroot00000000000000;; -*- mode: common-lisp; package: net.aserve.examples -*- ;; ;; puzzle.cl ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of ;; the GNU Lesser General Public License as published by ;; the Free Software Foundation; ;; ;; This code 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 ;; Lesser General Public License for more details. ;; ;; Version 2.1 of the GNU Lesser General Public License is in the file ;; license-lgpl.txt that was distributed with this file. ;; If it is not present, you can access it from ;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; ;; $Id: puzzle.cl,v 1.3 2002-12-26 19:55:44 rudi Exp $ ;; Description: ;; Allegro Serve puzzle example ;; Original Author: Charles A. Cox, Franz Inc. (defpackage puzzle (:use :common-lisp :acl-compat.excl)) (in-package :puzzle) (eval-when (compile load eval) (require :aserve)) (defpackage puzzle (:use :net.html.generator :net.aserve)) (defparameter .directions. (make-array 8 :initial-contents '((-1 . -1) ; nw (-1 . 0) ; n (-1 . +1) ; ne (0 . -1) ; w (0 . +1) ; e (+1 . -1) ; sw (+1 . 0) ; s (+1 . +1) ; se ))) ;; Bitmap of all Unicode characters whose name includes "letter". (defparameter .unicode-letters-bm. (let ((a (make-array #.(expt 2 16) :element-type 'bit :initial-element 0))) (dolist (c '(#x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 #x0048 #x0049 #x004a #x004b #x004c #x004d #x004e #x004f #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 #x0058 #x0059 #x005a #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 #x0068 #x0069 #x006a #x006b #x006c #x006d #x006e #x006f #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 #x0078 #x0079 #x007a #x00c0 #x00c1 #x00c2 #x00c3 #x00c4 #x00c5 #x00c6 #x00c7 #x00c8 #x00c9 #x00ca #x00cb #x00cc #x00cd #x00ce #x00cf #x00d0 #x00d1 #x00d2 #x00d3 #x00d4 #x00d5 #x00d6 #x00d8 #x00d9 #x00da #x00db #x00dc #x00dd #x00de #x00df #x00e0 #x00e1 #x00e2 #x00e3 #x00e4 #x00e5 #x00e6 #x00e7 #x00e8 #x00e9 #x00ea #x00eb #x00ec #x00ed #x00ee #x00ef #x00f0 #x00f1 #x00f2 #x00f3 #x00f4 #x00f5 #x00f6 #x00f8 #x00f9 #x00fa #x00fb #x00fc #x00fd #x00fe #x00ff #x0100 #x0101 #x0102 #x0103 #x0104 #x0105 #x0106 #x0107 #x0108 #x0109 #x010a #x010b #x010c #x010d #x010e #x010f #x0110 #x0111 #x0112 #x0113 #x0114 #x0115 #x0116 #x0117 #x0118 #x0119 #x011a #x011b #x011c #x011d #x011e #x011f #x0120 #x0121 #x0122 #x0123 #x0124 #x0125 #x0126 #x0127 #x0128 #x0129 #x012a #x012b #x012c #x012d #x012e #x012f #x0130 #x0131 #x0134 #x0135 #x0136 #x0137 #x0138 #x0139 #x013a #x013b #x013c #x013d #x013e #x013f #x0140 #x0141 #x0142 #x0143 #x0144 #x0145 #x0146 #x0147 #x0148 #x0149 #x014a #x014b #x014c #x014d #x014e #x014f #x0150 #x0151 #x0154 #x0155 #x0156 #x0157 #x0158 #x0159 #x015a #x015b #x015c #x015d #x015e #x015f #x0160 #x0161 #x0162 #x0163 #x0164 #x0165 #x0166 #x0167 #x0168 #x0169 #x016a #x016b #x016c #x016d #x016e #x016f #x0170 #x0171 #x0172 #x0173 #x0174 #x0175 #x0176 #x0177 #x0178 #x0179 #x017a #x017b #x017c #x017d #x017e #x017f #x0180 #x0181 #x0182 #x0183 #x0184 #x0185 #x0186 #x0187 #x0188 #x0189 #x018a #x018b #x018c #x018d #x018e #x018f #x0190 #x0191 #x0192 #x0193 #x0194 #x0195 #x0196 #x0197 #x0198 #x0199 #x019a #x019b #x019c #x019d #x019e #x019f #x01a0 #x01a1 #x01a2 #x01a3 #x01a4 #x01a5 #x01a6 #x01a7 #x01a8 #x01a9 #x01aa #x01ab #x01ac #x01ad #x01ae #x01af #x01b0 #x01b1 #x01b2 #x01b3 #x01b4 #x01b5 #x01b6 #x01b7 #x01b8 #x01b9 #x01ba #x01bb #x01bc #x01bd #x01be #x01bf #x01c0 #x01c1 #x01c2 #x01c3 #x01c4 #x01c5 #x01c6 #x01c7 #x01c8 #x01c9 #x01ca #x01cb #x01cc #x01cd #x01ce #x01cf #x01d0 #x01d1 #x01d2 #x01d3 #x01d4 #x01d5 #x01d6 #x01d7 #x01d8 #x01d9 #x01da #x01db #x01dc #x01dd #x01de #x01df #x01e0 #x01e1 #x01e2 #x01e3 #x01e4 #x01e5 #x01e6 #x01e7 #x01e8 #x01e9 #x01ea #x01eb #x01ec #x01ed #x01ee #x01ef #x01f0 #x01f1 #x01f2 #x01f3 #x01f4 #x01f5 #x01fa #x01fb #x01fc #x01fd #x01fe #x01ff #x0200 #x0201 #x0202 #x0203 #x0204 #x0205 #x0206 #x0207 #x0208 #x0209 #x020a #x020b #x020c #x020d #x020e #x020f #x0210 #x0211 #x0212 #x0213 #x0214 #x0215 #x0216 #x0217 #x0250 #x0251 #x0252 #x0253 #x0254 #x0255 #x0256 #x0257 #x0258 #x0259 #x025a #x025b #x025c #x025d #x025e #x025f #x0260 #x0261 #x0262 #x0263 #x0264 #x0265 #x0266 #x0267 #x0268 #x0269 #x026a #x026b #x026c #x026d #x026e #x026f #x0270 #x0271 #x0272 #x0273 #x0274 #x0275 #x0276 #x0277 #x0278 #x0279 #x027a #x027b #x027c #x027d #x027e #x027f #x0280 #x0281 #x0282 #x0283 #x0284 #x0285 #x0286 #x0287 #x0288 #x0289 #x028a #x028b #x028c #x028d #x028e #x028f #x0290 #x0291 #x0292 #x0293 #x0294 #x0295 #x0296 #x0297 #x0298 #x0299 #x029a #x029b #x029c #x029d #x029e #x029f #x02a0 #x02a1 #x02a2 #x02a3 #x02a4 #x02a5 #x02a6 #x02a7 #x02a8 #x02b0 #x02b1 #x02b2 #x02b3 #x02b4 #x02b5 #x02b6 #x02b7 #x02b8 #x02b9 #x02ba #x02bb #x02bc #x02bd #x02be #x02bf #x02c0 #x02c1 #x02c2 #x02c3 #x02c4 #x02c5 #x02c6 #x02c8 #x02c9 #x02ca #x02cb #x02cc #x02cd #x02ce #x02cf #x02d0 #x02d1 #x02d2 #x02d3 #x02d4 #x02d5 #x02d6 #x02d7 #x02de #x02e0 #x02e1 #x02e2 #x02e3 #x02e4 #x02e5 #x02e6 #x02e7 #x02e8 #x02e9 #x0386 #x0388 #x0389 #x038a #x038c #x038e #x038f #x0390 #x0391 #x0392 #x0393 #x0394 #x0395 #x0396 #x0397 #x0398 #x0399 #x039a #x039b #x039c #x039d #x039e #x039f #x03a0 #x03a1 #x03a3 #x03a4 #x03a5 #x03a6 #x03a7 #x03a8 #x03a9 #x03aa #x03ab #x03ac #x03ad #x03ae #x03af #x03b0 #x03b1 #x03b2 #x03b3 #x03b4 #x03b5 #x03b6 #x03b7 #x03b8 #x03b9 #x03ba #x03bb #x03bc #x03bd #x03be #x03bf #x03c0 #x03c1 #x03c2 #x03c3 #x03c4 #x03c5 #x03c6 #x03c7 #x03c8 #x03c9 #x03ca #x03cb #x03cc #x03cd #x03ce #x03da #x03dc #x03de #x03e0 #x03e2 #x03e3 #x03e4 #x03e5 #x03e6 #x03e7 #x03e8 #x03e9 #x03ea #x03eb #x03ec #x03ed #x03ee #x03ef #x03f3 #x0401 #x0402 #x0403 #x0404 #x0405 #x0406 #x0407 #x0408 #x0409 #x040a #x040b #x040c #x040e #x040f #x0410 #x0411 #x0412 #x0413 #x0414 #x0415 #x0416 #x0417 #x0418 #x0419 #x041a #x041b #x041c #x041d #x041e #x041f #x0420 #x0421 #x0422 #x0423 #x0424 #x0425 #x0426 #x0427 #x0428 #x0429 #x042a #x042b #x042c #x042d #x042e #x042f #x0430 #x0431 #x0432 #x0433 #x0434 #x0435 #x0436 #x0437 #x0438 #x0439 #x043a #x043b #x043c #x043d #x043e #x043f #x0440 #x0441 #x0442 #x0443 #x0444 #x0445 #x0446 #x0447 #x0448 #x0449 #x044a #x044b #x044c #x044d #x044e #x044f #x0451 #x0452 #x0453 #x0454 #x0455 #x0456 #x0457 #x0458 #x0459 #x045a #x045b #x045c #x045e #x045f #x0460 #x0461 #x0462 #x0463 #x0464 #x0465 #x0466 #x0467 #x0468 #x0469 #x046a #x046b #x046c #x046d #x046e #x046f #x0470 #x0471 #x0472 #x0473 #x0474 #x0475 #x0476 #x0477 #x0478 #x0479 #x047a #x047b #x047c #x047d #x047e #x047f #x0480 #x0481 #x0490 #x0491 #x0492 #x0493 #x0494 #x0495 #x0496 #x0497 #x0498 #x0499 #x049a #x049b #x049c #x049d #x049e #x049f #x04a0 #x04a1 #x04a2 #x04a3 #x04a6 #x04a7 #x04a8 #x04a9 #x04aa #x04ab #x04ac #x04ad #x04ae #x04af #x04b0 #x04b1 #x04b2 #x04b3 #x04b6 #x04b7 #x04b8 #x04b9 #x04ba #x04bb #x04bc #x04bd #x04be #x04bf #x04c0 #x04c1 #x04c2 #x04c3 #x04c4 #x04c7 #x04c8 #x04cb #x04cc #x04d0 #x04d1 #x04d2 #x04d3 #x04d6 #x04d7 #x04d8 #x04d9 #x04da #x04db #x04dc #x04dd #x04de #x04df #x04e0 #x04e1 #x04e2 #x04e3 #x04e4 #x04e5 #x04e6 #x04e7 #x04e8 #x04e9 #x04ea #x04eb #x04ee #x04ef #x04f0 #x04f1 #x04f2 #x04f3 #x04f4 #x04f5 #x04f8 #x04f9 #x0531 #x0532 #x0533 #x0534 #x0535 #x0536 #x0537 #x0538 #x0539 #x053a #x053b #x053c #x053d #x053e #x053f #x0540 #x0541 #x0542 #x0543 #x0544 #x0545 #x0546 #x0547 #x0548 #x0549 #x054a #x054b #x054c #x054d #x054e #x054f #x0550 #x0551 #x0552 #x0553 #x0554 #x0555 #x0556 #x0559 #x0561 #x0562 #x0563 #x0564 #x0565 #x0566 #x0567 #x0568 #x0569 #x056a #x056b #x056c #x056d #x056e #x056f #x0570 #x0571 #x0572 #x0573 #x0574 #x0575 #x0576 #x0577 #x0578 #x0579 #x057a #x057b #x057c #x057d #x057e #x057f #x0580 #x0581 #x0582 #x0583 #x0584 #x0585 #x0586 #x05d0 #x05d1 #x05d2 #x05d3 #x05d4 #x05d5 #x05d6 #x05d7 #x05d8 #x05d9 #x05da #x05db #x05dc #x05dd #x05de #x05df #x05e0 #x05e1 #x05e2 #x05e3 #x05e4 #x05e5 #x05e6 #x05e7 #x05e8 #x05e9 #x05ea #x0621 #x0622 #x0623 #x0624 #x0625 #x0626 #x0627 #x0628 #x0629 #x062a #x062b #x062c #x062d #x062e #x062f #x0630 #x0631 #x0632 #x0633 #x0634 #x0635 #x0636 #x0637 #x0638 #x0639 #x063a #x0641 #x0642 #x0643 #x0644 #x0645 #x0646 #x0647 #x0648 #x0649 #x064a #x0670 #x0671 #x0672 #x0673 #x0674 #x0675 #x0676 #x0677 #x0678 #x0679 #x067a #x067b #x067c #x067d #x067e #x067f #x0680 #x0681 #x0682 #x0683 #x0684 #x0685 #x0686 #x0687 #x0688 #x0689 #x068a #x068b #x068c #x068d #x068e #x068f #x0690 #x0691 #x0692 #x0693 #x0694 #x0695 #x0696 #x0697 #x0698 #x0699 #x069a #x069b #x069c #x069d #x069e #x069f #x06a0 #x06a1 #x06a2 #x06a3 #x06a4 #x06a5 #x06a6 #x06a7 #x06a8 #x06a9 #x06aa #x06ab #x06ac #x06ad #x06ae #x06af #x06b0 #x06b1 #x06b2 #x06b3 #x06b4 #x06b5 #x06b6 #x06b7 #x06ba #x06bb #x06bc #x06bd #x06be #x06c0 #x06c1 #x06c2 #x06c3 #x06c4 #x06c5 #x06c6 #x06c7 #x06c8 #x06c9 #x06ca #x06cb #x06cc #x06cd #x06ce #x06d0 #x06d1 #x06d2 #x06d3 #x06d5 #x0905 #x0906 #x0907 #x0908 #x0909 #x090a #x090b #x090c #x090d #x090e #x090f #x0910 #x0911 #x0912 #x0913 #x0914 #x0915 #x0916 #x0917 #x0918 #x0919 #x091a #x091b #x091c #x091d #x091e #x091f #x0920 #x0921 #x0922 #x0923 #x0924 #x0925 #x0926 #x0927 #x0928 #x0929 #x092a #x092b #x092c #x092d #x092e #x092f #x0930 #x0931 #x0932 #x0933 #x0934 #x0935 #x0936 #x0937 #x0938 #x0939 #x0958 #x0959 #x095a #x095b #x095c #x095d #x095e #x095f #x0960 #x0961 #x0985 #x0986 #x0987 #x0988 #x0989 #x098a #x098b #x098c #x098f #x0990 #x0993 #x0994 #x0995 #x0996 #x0997 #x0998 #x0999 #x099a #x099b #x099c #x099d #x099e #x099f #x09a0 #x09a1 #x09a2 #x09a3 #x09a4 #x09a5 #x09a6 #x09a7 #x09a8 #x09aa #x09ab #x09ac #x09ad #x09ae #x09af #x09b0 #x09b2 #x09b6 #x09b7 #x09b8 #x09b9 #x09dc #x09dd #x09df #x09e0 #x09e1 #x09f0 #x09f1 #x0a05 #x0a06 #x0a07 #x0a08 #x0a09 #x0a0a #x0a0f #x0a10 #x0a13 #x0a14 #x0a15 #x0a16 #x0a17 #x0a18 #x0a19 #x0a1a #x0a1b #x0a1c #x0a1d #x0a1e #x0a1f #x0a20 #x0a21 #x0a22 #x0a23 #x0a24 #x0a25 #x0a26 #x0a27 #x0a28 #x0a2a #x0a2b #x0a2c #x0a2d #x0a2e #x0a2f #x0a30 #x0a32 #x0a33 #x0a35 #x0a36 #x0a38 #x0a39 #x0a59 #x0a5a #x0a5b #x0a5c #x0a5e #x0a85 #x0a86 #x0a87 #x0a88 #x0a89 #x0a8a #x0a8b #x0a8f #x0a90 #x0a93 #x0a94 #x0a95 #x0a96 #x0a97 #x0a98 #x0a99 #x0a9a #x0a9b #x0a9c #x0a9d #x0a9e #x0a9f #x0aa0 #x0aa1 #x0aa2 #x0aa3 #x0aa4 #x0aa5 #x0aa6 #x0aa7 #x0aa8 #x0aaa #x0aab #x0aac #x0aad #x0aae #x0aaf #x0ab0 #x0ab2 #x0ab3 #x0ab5 #x0ab6 #x0ab7 #x0ab8 #x0ab9 #x0ae0 #x0b05 #x0b06 #x0b07 #x0b08 #x0b09 #x0b0a #x0b0b #x0b0c #x0b0f #x0b10 #x0b13 #x0b14 #x0b15 #x0b16 #x0b17 #x0b18 #x0b19 #x0b1a #x0b1b #x0b1c #x0b1d #x0b1e #x0b1f #x0b20 #x0b21 #x0b22 #x0b23 #x0b24 #x0b25 #x0b26 #x0b27 #x0b28 #x0b2a #x0b2b #x0b2c #x0b2d #x0b2e #x0b2f #x0b30 #x0b32 #x0b33 #x0b36 #x0b37 #x0b38 #x0b39 #x0b5c #x0b5d #x0b5f #x0b60 #x0b61 #x0b85 #x0b86 #x0b87 #x0b88 #x0b89 #x0b8a #x0b8e #x0b8f #x0b90 #x0b92 #x0b93 #x0b94 #x0b95 #x0b99 #x0b9a #x0b9c #x0b9e #x0b9f #x0ba3 #x0ba4 #x0ba8 #x0ba9 #x0baa #x0bae #x0baf #x0bb0 #x0bb1 #x0bb2 #x0bb3 #x0bb4 #x0bb5 #x0bb7 #x0bb8 #x0bb9 #x0c05 #x0c06 #x0c07 #x0c08 #x0c09 #x0c0a #x0c0b #x0c0c #x0c0e #x0c0f #x0c10 #x0c12 #x0c13 #x0c14 #x0c15 #x0c16 #x0c17 #x0c18 #x0c19 #x0c1a #x0c1b #x0c1c #x0c1d #x0c1e #x0c1f #x0c20 #x0c21 #x0c22 #x0c23 #x0c24 #x0c25 #x0c26 #x0c27 #x0c28 #x0c2a #x0c2b #x0c2c #x0c2d #x0c2e #x0c2f #x0c30 #x0c31 #x0c32 #x0c33 #x0c35 #x0c36 #x0c37 #x0c38 #x0c39 #x0c60 #x0c61 #x0c85 #x0c86 #x0c87 #x0c88 #x0c89 #x0c8a #x0c8b #x0c8c #x0c8e #x0c8f #x0c90 #x0c92 #x0c93 #x0c94 #x0c95 #x0c96 #x0c97 #x0c98 #x0c99 #x0c9a #x0c9b #x0c9c #x0c9d #x0c9e #x0c9f #x0ca0 #x0ca1 #x0ca2 #x0ca3 #x0ca4 #x0ca5 #x0ca6 #x0ca7 #x0ca8 #x0caa #x0cab #x0cac #x0cad #x0cae #x0caf #x0cb0 #x0cb1 #x0cb2 #x0cb3 #x0cb5 #x0cb6 #x0cb7 #x0cb8 #x0cb9 #x0cde #x0ce0 #x0ce1 #x0d05 #x0d06 #x0d07 #x0d08 #x0d09 #x0d0a #x0d0b #x0d0c #x0d0e #x0d0f #x0d10 #x0d12 #x0d13 #x0d14 #x0d15 #x0d16 #x0d17 #x0d18 #x0d19 #x0d1a #x0d1b #x0d1c #x0d1d #x0d1e #x0d1f #x0d20 #x0d21 #x0d22 #x0d23 #x0d24 #x0d25 #x0d26 #x0d27 #x0d28 #x0d2a #x0d2b #x0d2c #x0d2d #x0d2e #x0d2f #x0d30 #x0d31 #x0d32 #x0d33 #x0d34 #x0d35 #x0d36 #x0d37 #x0d38 #x0d39 #x0d60 #x0d61 #x0e81 #x0e82 #x0e84 #x0e87 #x0e88 #x0e8a #x0e8d #x0e94 #x0e95 #x0e96 #x0e97 #x0e99 #x0e9a #x0e9b #x0e9c #x0e9d #x0e9e #x0e9f #x0ea1 #x0ea2 #x0ea3 #x0ea5 #x0ea7 #x0eaa #x0eab #x0ead #x0eae #x0f40 #x0f41 #x0f42 #x0f43 #x0f44 #x0f45 #x0f46 #x0f47 #x0f49 #x0f4a #x0f4b #x0f4c #x0f4d #x0f4e #x0f4f #x0f50 #x0f51 #x0f52 #x0f53 #x0f54 #x0f55 #x0f56 #x0f57 #x0f58 #x0f59 #x0f5a #x0f5b #x0f5c #x0f5d #x0f5e #x0f5f #x0f60 #x0f61 #x0f62 #x0f63 #x0f64 #x0f65 #x0f66 #x0f67 #x0f68 #x0f69 #x0f90 #x0f91 #x0f92 #x0f93 #x0f94 #x0f95 #x0f97 #x0f99 #x0f9a #x0f9b #x0f9c #x0f9d #x0f9e #x0f9f #x0fa0 #x0fa1 #x0fa2 #x0fa3 #x0fa4 #x0fa5 #x0fa6 #x0fa7 #x0fa8 #x0fa9 #x0faa #x0fab #x0fac #x0fad #x0fb1 #x0fb2 #x0fb3 #x0fb4 #x0fb5 #x0fb6 #x0fb7 #x0fb9 #x10a0 #x10a1 #x10a2 #x10a3 #x10a4 #x10a5 #x10a6 #x10a7 #x10a8 #x10a9 #x10aa #x10ab #x10ac #x10ad #x10ae #x10af #x10b0 #x10b1 #x10b2 #x10b3 #x10b4 #x10b5 #x10b6 #x10b7 #x10b8 #x10b9 #x10ba #x10bb #x10bc #x10bd #x10be #x10bf #x10c0 #x10c1 #x10c2 #x10c3 #x10c4 #x10c5 #x10d0 #x10d1 #x10d2 #x10d3 #x10d4 #x10d5 #x10d6 #x10d7 #x10d8 #x10d9 #x10da #x10db #x10dc #x10dd #x10de #x10df #x10e0 #x10e1 #x10e2 #x10e3 #x10e4 #x10e5 #x10e6 #x10e7 #x10e8 #x10e9 #x10ea #x10eb #x10ec #x10ed #x10ee #x10ef #x10f0 #x10f1 #x10f2 #x10f3 #x10f4 #x10f5 #x10f6 #x1e00 #x1e01 #x1e02 #x1e03 #x1e04 #x1e05 #x1e06 #x1e07 #x1e08 #x1e09 #x1e0a #x1e0b #x1e0c #x1e0d #x1e0e #x1e0f #x1e10 #x1e11 #x1e12 #x1e13 #x1e14 #x1e15 #x1e16 #x1e17 #x1e18 #x1e19 #x1e1a #x1e1b #x1e1c #x1e1d #x1e1e #x1e1f #x1e20 #x1e21 #x1e22 #x1e23 #x1e24 #x1e25 #x1e26 #x1e27 #x1e28 #x1e29 #x1e2a #x1e2b #x1e2c #x1e2d #x1e2e #x1e2f #x1e30 #x1e31 #x1e32 #x1e33 #x1e34 #x1e35 #x1e36 #x1e37 #x1e38 #x1e39 #x1e3a #x1e3b #x1e3c #x1e3d #x1e3e #x1e3f #x1e40 #x1e41 #x1e42 #x1e43 #x1e44 #x1e45 #x1e46 #x1e47 #x1e48 #x1e49 #x1e4a #x1e4b #x1e4c #x1e4d #x1e4e #x1e4f #x1e50 #x1e51 #x1e52 #x1e53 #x1e54 #x1e55 #x1e56 #x1e57 #x1e58 #x1e59 #x1e5a #x1e5b #x1e5c #x1e5d #x1e5e #x1e5f #x1e60 #x1e61 #x1e62 #x1e63 #x1e64 #x1e65 #x1e66 #x1e67 #x1e68 #x1e69 #x1e6a #x1e6b #x1e6c #x1e6d #x1e6e #x1e6f #x1e70 #x1e71 #x1e72 #x1e73 #x1e74 #x1e75 #x1e76 #x1e77 #x1e78 #x1e79 #x1e7a #x1e7b #x1e7c #x1e7d #x1e7e #x1e7f #x1e80 #x1e81 #x1e82 #x1e83 #x1e84 #x1e85 #x1e86 #x1e87 #x1e88 #x1e89 #x1e8a #x1e8b #x1e8c #x1e8d #x1e8e #x1e8f #x1e90 #x1e91 #x1e92 #x1e93 #x1e94 #x1e95 #x1e96 #x1e97 #x1e98 #x1e99 #x1e9a #x1e9b #x1ea0 #x1ea1 #x1ea2 #x1ea3 #x1ea4 #x1ea5 #x1ea6 #x1ea7 #x1ea8 #x1ea9 #x1eaa #x1eab #x1eac #x1ead #x1eae #x1eaf #x1eb0 #x1eb1 #x1eb2 #x1eb3 #x1eb4 #x1eb5 #x1eb6 #x1eb7 #x1eb8 #x1eb9 #x1eba #x1ebb #x1ebc #x1ebd #x1ebe #x1ebf #x1ec0 #x1ec1 #x1ec2 #x1ec3 #x1ec4 #x1ec5 #x1ec6 #x1ec7 #x1ec8 #x1ec9 #x1eca #x1ecb #x1ecc #x1ecd #x1ece #x1ecf #x1ed0 #x1ed1 #x1ed2 #x1ed3 #x1ed4 #x1ed5 #x1ed6 #x1ed7 #x1ed8 #x1ed9 #x1eda #x1edb #x1edc #x1edd #x1ede #x1edf #x1ee0 #x1ee1 #x1ee2 #x1ee3 #x1ee4 #x1ee5 #x1ee6 #x1ee7 #x1ee8 #x1ee9 #x1eea #x1eeb #x1eec #x1eed #x1eee #x1eef #x1ef0 #x1ef1 #x1ef2 #x1ef3 #x1ef4 #x1ef5 #x1ef6 #x1ef7 #x1ef8 #x1ef9 #x1f00 #x1f01 #x1f02 #x1f03 #x1f04 #x1f05 #x1f06 #x1f07 #x1f08 #x1f09 #x1f0a #x1f0b #x1f0c #x1f0d #x1f0e #x1f0f #x1f10 #x1f11 #x1f12 #x1f13 #x1f14 #x1f15 #x1f18 #x1f19 #x1f1a #x1f1b #x1f1c #x1f1d #x1f20 #x1f21 #x1f22 #x1f23 #x1f24 #x1f25 #x1f26 #x1f27 #x1f28 #x1f29 #x1f2a #x1f2b #x1f2c #x1f2d #x1f2e #x1f2f #x1f30 #x1f31 #x1f32 #x1f33 #x1f34 #x1f35 #x1f36 #x1f37 #x1f38 #x1f39 #x1f3a #x1f3b #x1f3c #x1f3d #x1f3e #x1f3f #x1f40 #x1f41 #x1f42 #x1f43 #x1f44 #x1f45 #x1f48 #x1f49 #x1f4a #x1f4b #x1f4c #x1f4d #x1f50 #x1f51 #x1f52 #x1f53 #x1f54 #x1f55 #x1f56 #x1f57 #x1f59 #x1f5b #x1f5d #x1f5f #x1f60 #x1f61 #x1f62 #x1f63 #x1f64 #x1f65 #x1f66 #x1f67 #x1f68 #x1f69 #x1f6a #x1f6b #x1f6c #x1f6d #x1f6e #x1f6f #x1f70 #x1f71 #x1f72 #x1f73 #x1f74 #x1f75 #x1f76 #x1f77 #x1f78 #x1f79 #x1f7a #x1f7b #x1f7c #x1f7d #x1f80 #x1f81 #x1f82 #x1f83 #x1f84 #x1f85 #x1f86 #x1f87 #x1f88 #x1f89 #x1f8a #x1f8b #x1f8c #x1f8d #x1f8e #x1f8f #x1f90 #x1f91 #x1f92 #x1f93 #x1f94 #x1f95 #x1f96 #x1f97 #x1f98 #x1f99 #x1f9a #x1f9b #x1f9c #x1f9d #x1f9e #x1f9f #x1fa0 #x1fa1 #x1fa2 #x1fa3 #x1fa4 #x1fa5 #x1fa6 #x1fa7 #x1fa8 #x1fa9 #x1faa #x1fab #x1fac #x1fad #x1fae #x1faf #x1fb0 #x1fb1 #x1fb2 #x1fb3 #x1fb4 #x1fb6 #x1fb7 #x1fb8 #x1fb9 #x1fba #x1fbb #x1fbc #x1fc2 #x1fc3 #x1fc4 #x1fc6 #x1fc7 #x1fc8 #x1fc9 #x1fca #x1fcb #x1fcc #x1fd0 #x1fd1 #x1fd2 #x1fd3 #x1fd6 #x1fd7 #x1fd8 #x1fd9 #x1fda #x1fdb #x1fe0 #x1fe1 #x1fe2 #x1fe3 #x1fe4 #x1fe5 #x1fe6 #x1fe7 #x1fe8 #x1fe9 #x1fea #x1feb #x1fec #x1ff2 #x1ff3 #x1ff4 #x1ff6 #x1ff7 #x1ff8 #x1ff9 #x1ffa #x1ffb #x1ffc #x207f #x210c #x2111 #x211c #x2128 #x2129 #x212d #x249c #x249d #x249e #x249f #x24a0 #x24a1 #x24a2 #x24a3 #x24a4 #x24a5 #x24a6 #x24a7 #x24a8 #x24a9 #x24aa #x24ab #x24ac #x24ad #x24ae #x24af #x24b0 #x24b1 #x24b2 #x24b3 #x24b4 #x24b5 #x24b6 #x24b7 #x24b8 #x24b9 #x24ba #x24bb #x24bc #x24bd #x24be #x24bf #x24c0 #x24c1 #x24c2 #x24c3 #x24c4 #x24c5 #x24c6 #x24c7 #x24c8 #x24c9 #x24ca #x24cb #x24cc #x24cd #x24ce #x24cf #x24d0 #x24d1 #x24d2 #x24d3 #x24d4 #x24d5 #x24d6 #x24d7 #x24d8 #x24d9 #x24da #x24db #x24dc #x24dd #x24de #x24df #x24e0 #x24e1 #x24e2 #x24e3 #x24e4 #x24e5 #x24e6 #x24e7 #x24e8 #x24e9 #x3041 #x3042 #x3043 #x3044 #x3045 #x3046 #x3047 #x3048 #x3049 #x304a #x304b #x304c #x304d #x304e #x304f #x3050 #x3051 #x3052 #x3053 #x3054 #x3055 #x3056 #x3057 #x3058 #x3059 #x305a #x305b #x305c #x305d #x305e #x305f #x3060 #x3061 #x3062 #x3063 #x3064 #x3065 #x3066 #x3067 #x3068 #x3069 #x306a #x306b #x306c #x306d #x306e #x306f #x3070 #x3071 #x3072 #x3073 #x3074 #x3075 #x3076 #x3077 #x3078 #x3079 #x307a #x307b #x307c #x307d #x307e #x307f #x3080 #x3081 #x3082 #x3083 #x3084 #x3085 #x3086 #x3087 #x3088 #x3089 #x308a #x308b #x308c #x308d #x308e #x308f #x3090 #x3091 #x3092 #x3093 #x3094 #x30a1 #x30a2 #x30a3 #x30a4 #x30a5 #x30a6 #x30a7 #x30a8 #x30a9 #x30aa #x30ab #x30ac #x30ad #x30ae #x30af #x30b0 #x30b1 #x30b2 #x30b3 #x30b4 #x30b5 #x30b6 #x30b7 #x30b8 #x30b9 #x30ba #x30bb #x30bc #x30bd #x30be #x30bf #x30c0 #x30c1 #x30c2 #x30c3 #x30c4 #x30c5 #x30c6 #x30c7 #x30c8 #x30c9 #x30ca #x30cb #x30cc #x30cd #x30ce #x30cf #x30d0 #x30d1 #x30d2 #x30d3 #x30d4 #x30d5 #x30d6 #x30d7 #x30d8 #x30d9 #x30da #x30db #x30dc #x30dd #x30de #x30df #x30e0 #x30e1 #x30e2 #x30e3 #x30e4 #x30e5 #x30e6 #x30e7 #x30e8 #x30e9 #x30ea #x30eb #x30ec #x30ed #x30ee #x30ef #x30f0 #x30f1 #x30f2 #x30f3 #x30f4 #x30f5 #x30f6 #x30f7 #x30f8 #x30f9 #x30fa #x3105 #x3106 #x3107 #x3108 #x3109 #x310a #x310b #x310c #x310d #x310e #x310f #x3110 #x3111 #x3112 #x3113 #x3114 #x3115 #x3116 #x3117 #x3118 #x3119 #x311a #x311b #x311c #x311d #x311e #x311f #x3120 #x3121 #x3122 #x3123 #x3124 #x3125 #x3126 #x3127 #x3128 #x3129 #x312a #x312b #x312c #x3131 #x3132 #x3133 #x3134 #x3135 #x3136 #x3137 #x3138 #x3139 #x313a #x313b #x313c #x313d #x313e #x313f #x3140 #x3141 #x3142 #x3143 #x3144 #x3145 #x3146 #x3147 #x3148 #x3149 #x314a #x314b #x314c #x314d #x314e #x314f #x3150 #x3151 #x3152 #x3153 #x3154 #x3155 #x3156 #x3157 #x3158 #x3159 #x315a #x315b #x315c #x315d #x315e #x315f #x3160 #x3161 #x3162 #x3163 #x3165 #x3166 #x3167 #x3168 #x3169 #x316a #x316b #x316c #x316d #x316e #x316f #x3170 #x3171 #x3172 #x3173 #x3174 #x3175 #x3176 #x3177 #x3178 #x3179 #x317a #x317b #x317c #x317d #x317e #x317f #x3180 #x3181 #x3182 #x3183 #x3184 #x3185 #x3186 #x3187 #x3188 #x3189 #x318a #x318b #x318c #x318d #x318e #xfb20 #xfb21 #xfb22 #xfb23 #xfb24 #xfb25 #xfb26 #xfb27 #xfb28 #xfb29 #xfb2a #xfb2b #xfb2c #xfb2d #xfb2e #xfb2f #xfb30 #xfb31 #xfb32 #xfb33 #xfb34 #xfb35 #xfb36 #xfb38 #xfb39 #xfb3a #xfb3b #xfb3c #xfb3e #xfb40 #xfb41 #xfb43 #xfb44 #xfb46 #xfb47 #xfb48 #xfb49 #xfb4a #xfb4b #xfb4c #xfb4d #xfb4e #xfb50 #xfb51 #xfb52 #xfb53 #xfb54 #xfb55 #xfb56 #xfb57 #xfb58 #xfb59 #xfb5a #xfb5b #xfb5c #xfb5d #xfb5e #xfb5f #xfb60 #xfb61 #xfb62 #xfb63 #xfb64 #xfb65 #xfb66 #xfb67 #xfb68 #xfb69 #xfb6a #xfb6b #xfb6c #xfb6d #xfb6e #xfb6f #xfb70 #xfb71 #xfb72 #xfb73 #xfb74 #xfb75 #xfb76 #xfb77 #xfb78 #xfb79 #xfb7a #xfb7b #xfb7c #xfb7d #xfb7e #xfb7f #xfb80 #xfb81 #xfb82 #xfb83 #xfb84 #xfb85 #xfb86 #xfb87 #xfb88 #xfb89 #xfb8a #xfb8b #xfb8c #xfb8d #xfb8e #xfb8f #xfb90 #xfb91 #xfb92 #xfb93 #xfb94 #xfb95 #xfb96 #xfb97 #xfb98 #xfb99 #xfb9a #xfb9b #xfb9c #xfb9d #xfb9e #xfb9f #xfba0 #xfba1 #xfba2 #xfba3 #xfba4 #xfba5 #xfba6 #xfba7 #xfba8 #xfba9 #xfbaa #xfbab #xfbac #xfbad #xfbae #xfbaf #xfbb0 #xfbb1 #xfbd3 #xfbd4 #xfbd5 #xfbd6 #xfbd7 #xfbd8 #xfbd9 #xfbda #xfbdb #xfbdc #xfbdd #xfbde #xfbdf #xfbe0 #xfbe1 #xfbe2 #xfbe3 #xfbe4 #xfbe5 #xfbe6 #xfbe7 #xfbe8 #xfbe9 #xfbfc #xfbfd #xfbfe #xfbff #xfe80 #xfe81 #xfe82 #xfe83 #xfe84 #xfe85 #xfe86 #xfe87 #xfe88 #xfe89 #xfe8a #xfe8b #xfe8c #xfe8d #xfe8e #xfe8f #xfe90 #xfe91 #xfe92 #xfe93 #xfe94 #xfe95 #xfe96 #xfe97 #xfe98 #xfe99 #xfe9a #xfe9b #xfe9c #xfe9d #xfe9e #xfe9f #xfea0 #xfea1 #xfea2 #xfea3 #xfea4 #xfea5 #xfea6 #xfea7 #xfea8 #xfea9 #xfeaa #xfeab #xfeac #xfead #xfeae #xfeaf #xfeb0 #xfeb1 #xfeb2 #xfeb3 #xfeb4 #xfeb5 #xfeb6 #xfeb7 #xfeb8 #xfeb9 #xfeba #xfebb #xfebc #xfebd #xfebe #xfebf #xfec0 #xfec1 #xfec2 #xfec3 #xfec4 #xfec5 #xfec6 #xfec7 #xfec8 #xfec9 #xfeca #xfecb #xfecc #xfecd #xfece #xfecf #xfed0 #xfed1 #xfed2 #xfed3 #xfed4 #xfed5 #xfed6 #xfed7 #xfed8 #xfed9 #xfeda #xfedb #xfedc #xfedd #xfede #xfedf #xfee0 #xfee1 #xfee2 #xfee3 #xfee4 #xfee5 #xfee6 #xfee7 #xfee8 #xfee9 #xfeea #xfeeb #xfeec #xfeed #xfeee #xfeef #xfef0 #xfef1 #xfef2 #xfef3 #xfef4 #xff21 #xff22 #xff23 #xff24 #xff25 #xff26 #xff27 #xff28 #xff29 #xff2a #xff2b #xff2c #xff2d #xff2e #xff2f #xff30 #xff31 #xff32 #xff33 #xff34 #xff35 #xff36 #xff37 #xff38 #xff39 #xff3a #xff41 #xff42 #xff43 #xff44 #xff45 #xff46 #xff47 #xff48 #xff49 #xff4a #xff4b #xff4c #xff4d #xff4e #xff4f #xff50 #xff51 #xff52 #xff53 #xff54 #xff55 #xff56 #xff57 #xff58 #xff59 #xff5a #xff66 #xff67 #xff68 #xff69 #xff6a #xff6b #xff6c #xff6d #xff6e #xff6f #xff71 #xff72 #xff73 #xff74 #xff75 #xff76 #xff77 #xff78 #xff79 #xff7a #xff7b #xff7c #xff7d #xff7e #xff7f #xff80 #xff81 #xff82 #xff83 #xff84 #xff85 #xff86 #xff87 #xff88 #xff89 #xff8a #xff8b #xff8c #xff8d #xff8e #xff8f #xff90 #xff91 #xff92 #xff93 #xff94 #xff95 #xff96 #xff97 #xff98 #xff99 #xff9a #xff9b #xff9c #xff9d #xffa1 #xffa2 #xffa3 #xffa4 #xffa5 #xffa6 #xffa7 #xffa8 #xffa9 #xffaa #xffab #xffac #xffad #xffae #xffaf #xffb0 #xffb1 #xffb2 #xffb3 #xffb4 #xffb5 #xffb6 #xffb7 #xffb8 #xffb9 #xffba #xffbb #xffbc #xffbd #xffbe #xffc2 #xffc3 #xffc4 #xffc5 #xffc6 #xffc7 #xffca #xffcb #xffcc #xffcd #xffce #xffcf #xffd2 #xffd3 #xffd4 #xffd5 #xffd6 #xffd7 #xffda #xffdb #xffdc)) (setf (aref a c) 1)) a)) (defmacro cjk-p (code) `(or ;; CJK Ideographs (<= #x4e00 ,code #x9fff) ;; Hangul Syllables (<= #xac00 ,code #xd7a3))) (defmacro puzzle-rows (puzzle) `(first (array-dimensions ,puzzle))) (defmacro puzzle-cols (puzzle) `(second (array-dimensions ,puzzle))) (defun get-random-dir () (aref .directions. (random 8))) (defun get-random-start (puzzle) (cons (random (puzzle-rows puzzle)) (random (puzzle-cols puzzle)))) ;; Insert a word into a puzzle. (defun insert (word puzzle &key (install nil) (dir (get-random-dir)) (start (get-random-start puzzle)) (attempt 0) (extend-limit 0) (attempt-limit 100) &aux (length (length word)) (roff 0) (coff 0)) (macrolet ((retry () `(progn (incf attempt) (setq start (get-random-start puzzle) dir (get-random-dir)) (go :restart)))) (tagbody :restart (do ((row (car start) (+ row (car dir))) (col (cdr start) (+ col (cdr dir))) (i 0 (1+ i))) ((>= i (length word)) ;; if we're not already installing, then we arrive here when ;; we've passed all the tests and can begin installing. (if* (not install) then (setq install t) (go :restart))) ;; If we're installing, then just slap in the letter. Otherwise, ;; check if the letter fits and/or if the puzzle needs extending. (if* install then (setf (aref puzzle row col) (schar word i)) else (if* (or (< row 0) (< col 0) (>= row (first (array-dimensions puzzle))) (>= col (second (array-dimensions puzzle))) (>= attempt attempt-limit)) then ;; Don't allow puzzle size to extend unless we've tried ;; several attempts. (if* (>= attempt attempt-limit) then (incf extend-limit) (setq attempt 0)) (multiple-value-bind (npuzzle nroff ncoff) ;; We add 1 randomly to the row extension and to ;; the column extension to work around the problem where ;; the puzzle may already be completely full. (extend-puzzle puzzle extend-limit (+ (car start) (* (car dir) (- length (random 2)))) (+ (cdr start) (* (cdr dir) (- length (random 2))))) (if* npuzzle then (setq puzzle npuzzle) (incf roff nroff) (incf coff ncoff) (incf row nroff) (incf (car start) nroff) (incf col ncoff) (incf (cdr start) ncoff) else ;; extend-puzzle rejected because of ;; extend-limit, so we just loop around to ;; try again... (retry)))) (if* (and (aref puzzle row col) (not (eq (aref puzzle row col) (schar word i)))) then ;; existing letters in puzzle didn't match. So we ;; try again... (retry))))) (values puzzle start dir roff coff))) (defun extend-puzzle (puzzle extend-limit erow ecol &aux (prows (puzzle-rows puzzle)) (pcols (puzzle-cols puzzle))) (let* ((shift-rows (if* (minusp erow) then (- erow))) (shift-cols (if* (minusp ecol) then (- ecol))) (new-rows (+ prows (or shift-rows (max 0 (- (1+ erow) prows))))) (new-cols (+ pcols (or shift-cols (max 0 (- (1+ ecol) pcols)))))) (if* (or (> new-rows extend-limit) (> new-cols extend-limit)) then ;; reject (return-from extend-puzzle nil)) (setq shift-rows (or shift-rows 0)) (setq shift-cols (or shift-cols 0)) (setq puzzle (adjust-array puzzle (list new-rows new-cols) :initial-element nil)) (if* (or (minusp erow) (minusp ecol)) then (do ((r (- new-rows shift-rows 1) (1- r))) ((< r 0)) (do ((c (- new-cols shift-cols 1) (1- c))) ((< c 0)) (setf (aref puzzle (+ r shift-rows) (+ c shift-cols)) (aref puzzle r c))) (do ((c 0 (1+ c))) ((>= c shift-cols)) (setf (aref puzzle (+ r shift-rows) c) nil))) (do ((r 0 (1+ r))) ((>= r shift-rows)) (do ((c 0 (1+ c))) ((>= c new-cols)) (setf (aref puzzle r c) nil)))) (values puzzle shift-rows shift-cols))) (defun make-puzzle (word-list fill) ;; We actually make the puzzle twice, throwing away the first one after ;; getting its size. The idea is that words are likely to be more evenly ;; distributed in the second puzzle. (if* (not word-list) then (return-from make-puzzle nil)) (let ((puzzle (make-puzzle-1 word-list (make-array '(1 1) :initial-element nil :adjustable t) "none"))) (make-puzzle-1 word-list (make-array (array-dimensions puzzle) :initial-element nil :adjustable t) fill))) (defun make-puzzle-1 (word-list puzzle fill &aux (answers nil) (fill-sym (intern fill :keyword))) (dolist (word word-list) (multiple-value-bind (npuzzle start dir roff coff) (insert word puzzle) (setq puzzle npuzzle) (dolist (a answers) (incf (car (second a)) roff) (incf (cdr (second a)) coff)) (push (list word start dir) answers))) (dotimes (i (apply #'* (array-dimensions puzzle))) (if* (not (row-major-aref puzzle i)) then (setf (row-major-aref puzzle i) (ecase fill-sym (:|ascii-lc| (code-char (+ (random 26) #.(char-code #\a)))) (:|none| #\space) (:|unicode-nocjk| (loop (let ((c (random #.(expt 2 16)))) (if* (= 1 (aref .unicode-letters-bm. c)) then (return (code-char c)))))) (:|unicode-cjk| (loop (let ((c (random #.(expt 2 16)))) (if* (= 1 (aref .unicode-letters-bm. c)) then (return (code-char c))) (if* (cjk-p c) then (return (code-char c)))))))))) (values puzzle (coerce (sort answers #'(lambda (x y) (string< (car x) (car y)))) 'array))) (defun mark-puzzle (puzzle index answers) (let* ((answer (aref answers index)) (start (second answer)) (dir (third answer)) (length (length (car answer))) (row (car start)) (col (cdr start))) (dotimes (i length) (setf (aref puzzle row col) (cons (aref puzzle row col) nil)) (incf row (car dir)) (incf col (cdr dir))))) (defun unmark (puzzle row col) (if* (consp (aref puzzle row col)) then (setf (aref puzzle row col) (car (aref puzzle row col))) t)) (defun words-list (words-string) (do ((words nil) (words-chars (coerce words-string 'list))) ((null words-chars) (nreverse words)) (let ((word nil)) (loop (let ((char (pop words-chars))) (if* (or (null char) (member char '(#\space #\newline #\tab #\return #\linefeed))) then (push (coerce (nreverse word) 'string) words) (return) else (push char word))))))) (defun cannot-do-puzzle (req ent) (with-http-response (req ent) (with-http-body (req ent) (princ #.(format nil "~ This page available only with International Allegro CL post 6.0 beta") *html-stream*)))) (defun can-do-puzzle (req ent) (let ((puzzle-url (symbol-name (gensym "/wordpuzzle"))) (puzzle nil) (answers nil)) ;; publish new url on the fly. ;; Enhancement To Do: Allow puzzles to be deallocated, either by timeout ;; or some other mechanism. (publish :path puzzle-url :content-type "text/html; charset=utf-8" :function #'(lambda (req ent &aux (marked nil)) (let ((lookup (assoc "index" (request-query req :external-format :utf8-base) :test #'string=))) (if* lookup then (setq marked t) (mark-puzzle puzzle (read-from-string (cdr lookup)) answers))) (let* ((rq (request-query req :external-format :utf8-base)) (words-string (cdr (assoc "words" rq :test #'string=))) (fill (cdr (assoc "fill" rq :test #'string=)))) (if* words-string then (multiple-value-setq (puzzle answers) (make-puzzle (words-list words-string) fill)))) (with-http-response (req ent) (with-http-body (req ent :external-format :utf8-base) (html (:html (:head (:title "Puzzle")) (:body (:p #.(format nil "~ Characters that appear as dots or empty boxes or question-marks likely look that way because your browser is missing the needed font(s).")) (if* puzzle then (html (:center ((:table border 0 width "75%") (:tr (:td #.(format nil "~ Click on letter in puzzle to see its character description.")) (:td #.(format nil "~ Click on word to see its puzzle location."))) (:tr (:td ((:table border 0) (dotimes (r (puzzle-rows puzzle)) (html (:tr (dotimes (c (puzzle-cols puzzle)) (html ((:td :if* (unmark puzzle r c) :bgcolor "lime") ((:a href (format nil "/wp_echo?char=~a" (uriencode-string (format nil "u+~4,'0x:~s" (char-code (aref puzzle r c)) (aref puzzle r c))))) (:tt (:princ (aref puzzle r c)))))))))))) (:td ((:table border 0) (dotimes (i (length answers)) (let ((url (format nil "~a?index=~a" puzzle-url i))) (html (:tr (:td ((:a href url) (:princ (car (aref answers i))))))))))))))) else (html (:p "No words entered"))) (:p ((:a :href "/wordpuzzle") "New Puzzle")) (if* marked then (html (:p ((:a :href puzzle-url) "Clear Answer"))))))))))) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head (:title "Enter Words")) (:body (:p #.(format nil "~ Enter words separated by spaces or newlines. Click on `make puzzle' button ~ below to generate the puzzle.")) ((:form :action puzzle-url :method "POST") ((:textarea :name "words" :rows 15 :cols 50)) (:dl (:dt "Please select category of fill letters:") (:dd ((:input :type "radio" :name "fill" :value "ascii-lc" :checked "checked") "English Lower Case Only.")) (:dd ((:input :type "radio" :name "fill" :value "unicode-nocjk") "All Unicode Letters " (:em "except ") "Chinese-Japanese-Korean ideographs.")) (:dd ((:input :type "radio" :name "fill" :value "unicode-cjk") "All Unicode Letters " (:em "including ") "Chinese-Japanese-Korean ideographs.")) (:dd ((:input :type "radio" :name "fill" :value "none") "No fill characters."))) ((:input :type "submit" :value "make puzzle")) (:p #.(format nil "~ Below are links containing international character samples you can use to copy and paste into the word list. Note that even characters that don't display (due to missing fonts) can still be copied and pasted.")) (:ul (:li ((:a href #.(format nil "~ http://www.columbia.edu/kermit/utf8.html") target "_blank") "UTF-8 Sampler")) (:li ((:a href #.(format nil "~ http://www.trigeminal.com/samples/provincial.html") target "_blank") #.(format nil "~ The \"anyone can be provincial!\" page")))))))))))) ;; ;; the entry link to this demo: ;; (publish :path "/wordpuzzle" :content-type "text/html; charset=utf-8" :function #-(and allegro ics (version>= 6 0 pre-final 1)) #'(lambda (req ent) (cannot-do-puzzle req ent)) #+(and allegro ics (version>= 6 0 pre-final 1)) #'(lambda (req ent) ; test at runtime in case we compiled with an international lisp ; and are running in an 8bit lisp (if* (member :ics *features* :test #'eq) then (can-do-puzzle req ent) else (cannot-do-puzzle req ent)))) (publish :path "/wp_echo" :content-type "text/html; charset=utf-8" :function #'(lambda (req ent) (let ((lookup (assoc "char" (request-query req) :test #'string=))) (if* lookup then (setq lookup (let ((*read-base* 16)) (read-from-string (subseq (cdr lookup) #.(length "u+") #.(length "u+xxxx")))))) (with-http-response (req ent) (with-http-body (req ent :external-format :utf8-base) (html (:html (:head (:title "Character Description")) (:body (:p (:princ (format nil "Unicode value: U+~4,'0x" lookup))) (:p "Lisp Character Name: " ((:font :size "+3") (:prin1 (code-char lookup)))) (:p "Browser Font Display: " ((:font :size "+3") (:princ (code-char lookup))) :br #.(format nil "~ Characters that appear as dots or empty boxes or question-marks likely look that way because your browser is missing the needed font(s).")) (let ((uglyph (format nil "~ http://charts.unicode.org/Glyphs/~2,'0x/U~4,'0x.gif" (ldb (byte 8 8) lookup) lookup))) (html ((:table border 0) (:tr (:td #.(format nil "~ Glyph GIF (from Unicode web site -- not all characters have gifs):") :br (:princ (format nil "[Loading from `~a'.]" uglyph))) (:td ((:img :src uglyph :alt (format nil "~s" (code-char lookup)) :border 2))))))) (if* (cjk-p lookup) then (if* (<= #xac00 lookup #xd7a3) then (html (:p "Character is a Hangul Syllable.")) else (html (:p #.(format nil "~ Character is an ideograph from Chinese, Japanese, or Korean."))))) (:p #.(format nil "~ Use browser `Back' button to return to puzzle.")))))))))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/tutorial.cl000066400000000000000000000101551133377100500253160ustar00rootroot00000000000000;; -*- mode: common-lisp; package: tutorial -*- ;; ;; turorial.cl ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of ;; the GNU Lesser General Public License as published by ;; the Free Software Foundation; ;; ;; This code 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 ;; Lesser General Public License for more details. ;; ;; Version 2.1 of the GNU Lesser General Public License is in the file ;; license-lgpl.txt that was distributed with this file. ;; If it is not present, you can access it from ;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; ;; $Id: tutorial.cl,v 1.3 2002-12-26 19:55:44 rudi Exp $ ;; Description: ;; iserver tutorial examples ;;- This code in this file obeys the Lisp Coding Standard found in ;;- http://www.franz.com/~jkf/coding_standards.html ;;- (defpackage :tutorial (:use :common-lisp :acl-compat.excl :net.aserve :net.html.generator)) (in-package :tutorial) (publish :path "/hello" :content-type "text/plain" :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (princ "Hello World!" *html-stream*))))) (publish :path "/hello2" :content-type "text/html" :function #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head (:title "Hello World Test")) (:body ((:font :color "red") "Hello ") ((:font :color "blue") "World!")))))))) (publish :path "/hello-count" :content-type "text/html" :function (let ((count 0)) #'(lambda (req ent) (with-http-response (req ent) (with-http-body (req ent) (html (:html (:head (:title "Hello Counter")) (:body ((:font :color (nth (random 5) '("red" "blue" "green" "purple" "black"))) "Hello World had been called " (:princ (incf count)) " times"))))))))) (publish :path "/queryform" :content-type "text/html" :function #'(lambda (req ent) (let ((name (cdr (assoc "name" (request-query req) :test #'equal)))) (with-http-response (req ent) (with-http-body (req ent) (if* name then ; form was filled out, just say it (html (:html (:head (:title "Hi to " (:princ-safe name))) (:body "Your name is " (:b (:princ-safe name))))) else ; put up the form (html (:html (:head (:title "Tell me your name")) (:body ((:form :action "queryform") "Your name is " ((:input :type "text" :name "name" :maxlength "20")))))))))))) (publish :path "/charcount" :content-type "text/html" :function #'(lambda (req ent) (let* ((body (get-request-body req)) (text (if* body then (cdr (assoc "quotation" (form-urlencoded-to-query body) :test #'equal))))) (with-http-response (req ent) (with-http-body (req ent) (if* text then ; got the quotation, analyze it (html (:html (:head (:title "Character Counts") (:body (:table (do ((i #.(char-code #\a) (1+ i))) ((> i #.(char-code #\z))) (html (:tr (:td (:princ (code-char i))) (:td (:princ (count (code-char i) text))))))))))) else ; ask for quotation (html (:html (:head (:title "quote character counter") (:body ((:form :action "charcount" :method "POST") "Enter your favorite quote " :br ((:textarea :name "quotation" :rows 30 :cols 50)) :br ((:input :type "submit" :name "submit" :value "count it"))))))))))))) cl-portable-aserve-1.2.42+cvs.2010.02.08-dfsg/aserve/examples/urian.cl000066400000000000000000000345621133377100500246010ustar00rootroot00000000000000;; -*- mode: common-lisp; package: net.aserve.examples -*- ;; ;; urian.cl ;; ;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA ;; ;; This code is free software; you can redistribute it and/or ;; modify it under the terms of the version 2.1 of ;; the GNU Lesser General Public License as published by ;; the Free Software Foundation; ;; ;; This code 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 ;; Lesser General Public License for more details. ;; ;; Version 2.1 of the GNU Lesser General Public License is in the file ;; license-lgpl.txt that was distributed with this file. ;; If it is not present, you can access it from ;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; ;; $Id: urian.cl,v 1.3 2003-12-02 14:20:39 rudi Exp $ ;; Description: ;; urian example ;; ;; Web page character analyzer. ;; This example retrieves a web page associated with a url, parses it with ;; parse-html, and then displays all texts found to have non-ascii characters. ;; Each character is a link. Clicking on one of these links displays a ;; description of the linked character. ;; ;; Original Author: Charles A. Cox, Franz Inc., October 2000 ;; ;; To use, compile/load this file into Allegro CL 6.0. Then, ;; start allegroserve, eg, (net.aserve:start :port 8000) starts on port 8000. ;; The main published page for this example is "/urian". (defpackage :urian (:use :common-lisp :excl)) (in-package :urian) (eval-when (compile load eval) #+allegro (if* (not (featurep '(:version>= 6 0))) then (error "This file not supported in Allegro CL releases earlier than 6.0")) #-allegro (error "This file not supported on non-Allegro platforms")) (eval-when (compile load eval) (require :aserve) (handler-case (require :phtml) ; didn't find it, check to see if it's where it would be in ; a non-user file layout (error (c) (declare (ignore c)) (let (name) (if* (or (probe-file (setq name (concatenate 'string (directory-namestring *load-pathname*) "../xmlutils/phtml.fasl"))) (probe-file (setq name (concatenate 'string (directory-namestring *load-pathname*) "../../xmlutils/phtml.fasl")))) then (load name) else (format t " not at ~s~%, tn is ~s~%" name *load-pathname*) (error "can't locate phtml module")))))) (defpackage :urian (:use :net.html.generator :net.aserve :net.html.parser)) (pushnew :x-sjis (ef-nicknames (find-external-format :shiftjis))) (pushnew :shift-jis (ef-nicknames (find-external-format :shiftjis))) (pushnew :iso-8859-1 (ef-nicknames (find-external-format :latin1))) (pushnew :windows-1252 (ef-nicknames (find-external-format :1252))) (defparameter *blocks* '((#x0000 #x007f "Basic Latin") (#x0080 #x00ff "Latin-1 Supplement") (#x0100 #x017f "Latin Extended-A") (#x0180 #x024f "Latin Extended-B") (#x0250 #x02af "IPA Extensions") (#x02b0 #x02ff "Spacing Modifier Letters") (#x0300 #x036f "Combining Diacritical Marks") (#x0370 #x03ff "Greek") (#x0400 #x04ff "Cyrillic") (#x0530 #x058f "Armenian") (#x0590 #x05ff "Hebrew") (#x0600 #x06ff "Arabic") (#x0700 #x074f "Syriac ") (#x0780 #x07bf "Thaana") (#x0900 #x097f "Devanagari") (#x0980 #x09ff "Bengali") (#x0a00 #x0a7f "Gurmukhi") (#x0a80 #x0aff "Gujarati") (#x0b00 #x0b7f "Oriya") (#x0b80 #x0bff "Tamil") (#x0c00 #x0c7f "Telugu") (#x0c80 #x0cff "Kannada") (#x0d00 #x0d7f "Malayalam") (#x0d80 #x0dff "Sinhala") (#x0e00 #x0e7f "Thai") (#x0e80 #x0eff "Lao") (#x0f00 #x0fff "Tibetan") (#x1000 #x109f "Myanmar ") (#x10a0 #x10ff "Georgian") (#x1100 #x11ff "Hangul Jamo") (#x1200 #x137f "Ethiopic") (#x13a0 #x13ff "Cherokee") (#x1400 #x167f "Unified Canadian Aboriginal Syllabics") (#x1680 #x169f "Ogham") (#x16a0 #x16ff "Runic") (#x1780 #x17ff "Khmer") (#x1800 #x18af "Mongolian") (#x1e00 #x1eff "Latin Extended Additional") (#x1f00 #x1fff "Greek Extended") (#x2000 #x206f "General Punctuation") (#x2070 #x209f "Superscripts and Subscripts") (#x20a0 #x20cf "Currency Symbols") (#x20d0 #x20ff "Combining Marks for Symbols") (#x2100 #x214f "Letterlike Symbols") (#x2150 #x218f "Number Forms") (#x2190 #x21ff "Arrows") (#x2200 #x22ff "Mathematical Operators") (#x2300 #x23ff "Miscellaneous Technical") (#x2400 #x243f "Control Pictures") (#x2440 #x245f "Optical Character Recognition") (#x2460 #x24ff "Enclosed Alphanumerics") (#x2500 #x257f "Box Drawing") (#x2580 #x259f "Block Elements") (#x25a0 #x25ff "Geometric Shapes") (#x2600 #x26ff "Miscellaneous Symbols") (#x2700 #x27bf "Dingbats") (#x2800 #x28ff "Braille Patterns") (#x2e80 #x2eff "CJK Radicals Supplement") (#x2f00 #x2fdf "Kangxi Radicals") (#x2ff0 #x2fff "Ideographic Description Characters") (#x3000 #x303f "CJK Symbols and Punctuation") (#x3040 #x309f "Hiragana") (#x30a0 #x30ff "Katakana") (#x3100 #x312f "Bopomofo") (#x3130 #x318f "Hangul Compatibility Jamo") (#x3190 #x319f "Kanbun") (#x31a0 #x31bf "Bopomofo Extended") (#x3200 #x32ff "Enclosed CJK Letters and Months") (#x3300 #x33ff "CJK Compatibility") (#x3400 #x4db5 "CJK Unified Ideographs Extension A") (#x4e00 #x9fff "CJK Unified Ideographs") (#xa000 #xa48f "Yi Syllables") (#xa490 #xa4cf "Yi Radicals") (#xac00 #xd7a3 "Hangul Syllables") (#xd800 #xdb7f "High Surrogates") (#xdb80 #xdbff "High Private Use Surrogates") (#xdc00 #xdfff "Low Surrogates") (#xe000 #xf8ff "Private Use") (#xf900 #xfaff "CJK Compatibility Ideographs") (#xfb00 #xfb4f "Alphabetic Presentation Forms") (#xfb50 #xfdff "Arabic Presentation Forms-A") (#xfe20 #xfe2f "Combining Half Marks") (#xfe30 #xfe4f "CJK Compatibility Forms") (#xfe50 #xfe6f "Small Form Variants") (#xfe70 #xfefe "Arabic Presentation Forms-B") (#xfeff #xfeff "Specials") (#xff00 #xffef "Halfwidth and Fullwidth Forms") (#xfff0 #xfffd "Specials"))) (publish :path "/urian" :content-type "text/html; charset=utf-8" :function #'(lambda (req ent) (let* ((uri (cdr (assoc "uri" (request-query req) :test #'equal))) (results nil)) (when uri (unless (find #\: uri) (setq uri (concatenate 'string "http://" uri))) (setq results (chanal uri))) (with-http-response (req ent) (with-http-body (req ent :external-format :utf8-base) (html (:html (:head (:title (:princ-safe (format nil "String Analysis~@[ for `~a'~]" uri)))) (:body (if* (stringp results) then (html (:p "AllegroServe got error: " (:b (:princ-safe results)))) else (when results (when (first results) (html (:p (:princ-safe (format nil "Server set charset to `~s'." (car (first results)))) :br (:princ-safe (format nil "Switched to External-Format `~s'." (ef-name (cdr (first results)))))))) (when (second results) (html (:p (:princ-safe (format nil "A page meta tag specified charset as `~s'." (car (second results)))) :br (:princ-safe (format nil "Switched to external-format: `~s'." (ef-name (cdr (second results)))))))) (html (:p "Scanned URL: " ((:a :href uri target "_blank") (:princ-safe uri)))) (if* (cddr results) then (html (:p "The following texts were found to contain " "non-ASCII characters. " :br "Click on a character for its description.")) "Strings found on URL: " (dolist (result (cddr results)) (html :hr (san-html result *html-stream*))) else (html (:p "No texts containing non-ASCII characters " "were found on the page."))))) :hr (macrolet ((item (title url) ;; Assumes title and url are string literals (let ((ref (format nil "/urian?uri=~a" (uriencode-string url)))) `(html (:ul (:li (:princ-safe ,title) " (" (:princ-safe ,url) ")" :br ((:a href ,url target "_blank") "View Page (new browser window)") :br ((:a href ,ref) "Analyze"))))))) (html (:p "Select a sample page:" (item "UTF-8 Sampler" "http://www.columbia.edu/kermit/utf8.html") (item "The \"anyone can be provincial!\" page" "http://www.trigeminal.com/samples/provincial.html") (item "The Japan Netscape Netcenter Page" "http://home.netscape.com/ja") (item "The Spain Yahoo! Page" "http://es.yahoo.com")))) :br ((:form :action "urian" :method "get") "Or Enter New URL to analyze: " ((:input :type "text" :name "uri" :size 50))))))))))) (defun san-html (string stream) (net.html.generator:html-stream stream (net.html.generator:html (:p "\"" (dotimes (i (length string)) (net.html.generator:html ((:a href (format nil "/chdescribe?char=~a" (net.aserve:uriencode-string (format nil "u+~4,'0x:~s" (char-code (schar string i)) (schar string i))))) (:princ (schar string i))))) "\"")))) (defun chanal (uri &aux (server-ef nil) (lhtml nil) (metatag-ef nil)) (handler-case (multiple-value-bind (body response-code headers ruri) (net.aserve.client:do-http-request uri :external-format :latin1-base) (declare (ignore response-code ruri)) (setq server-ef (let ((content-type (cdr (assoc :content-type headers)))) (find-charset-from-content-type content-type))) (setq lhtml (net.html.parser:parse-html body)) (setq metatag-ef (update-ef lhtml)) (cons server-ef (cons metatag-ef (delete-duplicates (chanal-body lhtml (or (cdr metatag-ef) (cdr server-ef) ;; www.yahoo.co.jp uses euc without ;; specifying it. Let's try using ;; euc, then, as default. (crlf-base-ef (find-external-format :latin1)))) :test #'string=)))) (error (c) (format nil "~a" c)))) (defun chanal-body (body ef) (if* (stringp body) then (let ((s (octets-to-string (string-to-octets body :external-format :latin1-base) :external-format ef))) (dotimes (i (length s)) (when (> (char-code (schar s i)) #x7f) ;; non-ascii (return-from chanal-body (list s)))) nil) elseif (consp body) then ;; skip unparsed