diff --git a/scsh/SPAN/SPAN-server-daemon-record.scm b/scsh/SPAN/SPAN-server-daemon-record.scm new file mode 100644 index 0000000..62bd732 --- /dev/null +++ b/scsh/SPAN/SPAN-server-daemon-record.scm @@ -0,0 +1,42 @@ +;;; SPAN-server-daemon-record.scm - records for SPAN server side +;;; +;;; Copyright (c) 2011-2012 Johan Ceuppens +;;; +;;; All rights reserved. +;;; +;;; 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. +;;; 3. The name of the authors may not be used to endorse or promote products +;;; derived from this software without specific prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +;;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +;;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +;;; IN NO EVENT SHALL THE AUTHORS BE 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) HOWEVER CAUSED AND ON ANY +;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(define :SPAN-daemon-record + (make-record-type 'SPAN-daemon-record + '(hostname port sock motd ack bye))) +(define make-SPAN-daemon-record + (record-constructor :SPAN-daemon-record + '(hostname port sock motd ack bye))) + +(define hostname (record-accessor :SPAN-daemon-record 'hostname)) +(define port (record-accessor :SPAN-daemon-record 'port)) +(define sock (record-accessor :SPAN-daemon-record 'sock)) +(define motd (record-accessor :SPAN-daemon-record 'motd)) +(define ack (record-accessor :SPAN-daemon-record 'ack)) +(define bye (record-accessor :SPAN-daemon-record 'bye)) + diff --git a/scsh/SPAN/SPAN-server-daemon.scm b/scsh/SPAN/SPAN-server-daemon.scm new file mode 100644 index 0000000..f5ffdf2 --- /dev/null +++ b/scsh/SPAN/SPAN-server-daemon.scm @@ -0,0 +1,95 @@ +;;; tforks.scm - a scheme daemon child process +;;; +;;; Copyright (c) 2011-2012 Johan Ceuppens +;;; +;;; All rights reserved. +;;; +;;; 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. +;;; 3. The name of the authors may not be used to endorse or promote products +;;; derived from this software without specific prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +;;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +;;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +;;; IN NO EVENT SHALL THE AUTHORS BE 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) HOWEVER CAUSED AND ON ANY +;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(load "SPAN-server-daemon-record.scm") + +(define (errormsg) (display " message not understood. ")) +(define (eoln) (string #\newline)) +(define (servermsg) (display "::message::")) + + +(define (run-daemon-child-SPAN rec) + (let ((*hostname (hostname rec)) + (*port (port rec)) + (*socket (socket rec)) + (*motd (motd rec)) + (*ack (ack rec)) + (*apop (apop rec)) + (*stat (stat rec)) + (*list (list rec)) + (*bye (bye rec))) + + (set! *socket (open-socket *port)) + + (for-each display '("Opening SPAN server side : listening on host : " + *hostname + " port : " + *port + (eoln))) + + ((lambda () + (call-with-values + (lambda () + (socket-accept *socket)) + (lambda (in out) + (write *motd out) + (let ((answer (read (make-string-input-port in)))) + (for-each display '((servermsg) (symbol->string answer))) + (if (symbol? answer) + (cond ((eq? 'get answer) + (let ((answer2 (read (make-string-input-port in)))) + (write (tmail-get-mail-with-index (getenv "USER") idx) out))) + ((eq? 'QUIT answer) + (write *bye out) + (close-input-port in) + (close-socket *socket) + (close-output-port out) + (exit)) + (else + (write (errormsg) out)) + )) + )))) + (let ((answer2 (read (make-string-input-port in)))) + (for-each display '((servermsg) (symbol->string answer2))) + (write *bye out) + (close-input-port in) + (close-socket *socket) + (close-output-port out) + (exit))))) + + +(define rc (make-daemon-record + "localhost" ;; virtual host + 6969 + #f + "SPAN server side ready." + "Scheming..." + "SPAN server signing off." + )) + +(run-daemon-child-SPAN rc) diff --git a/scsh/SPAN/packages.scm b/scsh/SPAN/packages.scm index b958148..ef12d14 100644 --- a/scsh/SPAN/packages.scm +++ b/scsh/SPAN/packages.scm @@ -1,10 +1,9 @@ (define-interface SPAN-interface (export - make-SPAN-server - make-SPAN-client)) + SPAN-question~)) (define-structure SPAN schemedoc-interface (open scheme) - (files SPAN-client SPAN-server SPAN)) + (files SPAN-client SPAN-server SPAN load SPAN-util)) diff --git a/scsh/SPAN/pkg-def.scm b/scsh/SPAN/pkg-def.scm index ec1afbe..5714841 100644 --- a/scsh/SPAN/pkg-def.scm +++ b/scsh/SPAN/pkg-def.scm @@ -11,5 +11,6 @@ (install-file "packages.scm" 'scheme) (install-file "SPAN-client.scm" 'scheme) (install-file "SPAN-server.scm" 'scheme) + (install-file "SPAN-util.scm" 'scheme) (install-file "load.scm" 'scheme) (install-file "SPAN.scm" 'scheme)) diff --git a/scsh/tmail/trecords.scm b/scsh/tmail/trecords.scm index d7bb7d7..1dee8f9 100644 --- a/scsh/tmail/trecords.scm +++ b/scsh/tmail/trecords.scm @@ -40,6 +40,6 @@ (define ack (record-accessor :daemon-record 'ack)) (define apop (record-accessor :daemon-record 'apop)) (define stat (record-accessor :daemon-record 'stat)) -(define list (record-accessor :daemon-record 'Llist)) +(define list (record-accessor :daemon-record 'list)) (define bye (record-accessor :daemon-record 'bye))