From 8bd7a8994e1fc744ed4ef8746d80c97bc886ecdd Mon Sep 17 00:00:00 2001 From: erana Date: Thu, 26 Jan 2012 01:58:59 +0900 Subject: [PATCH] SPAN to CSAN name change --- .../CSAN/{SPAN-client.scm => CSAN-client.scm} | 0 scsh/CSAN/{SPAN.scm => CSAN.scm} | 0 scsh/CSAN/SPAN-server-daemon-record.scm | 42 ------- scsh/CSAN/SPAN-server-daemon.scm | 105 ------------------ scsh/CSAN/SPAN-server.scm | 39 ------- scsh/CSAN/SPAN-util.scm | 74 ------------ 6 files changed, 260 deletions(-) rename scsh/CSAN/{SPAN-client.scm => CSAN-client.scm} (100%) rename scsh/CSAN/{SPAN.scm => CSAN.scm} (100%) delete mode 100644 scsh/CSAN/SPAN-server-daemon-record.scm delete mode 100644 scsh/CSAN/SPAN-server-daemon.scm delete mode 100644 scsh/CSAN/SPAN-server.scm delete mode 100644 scsh/CSAN/SPAN-util.scm diff --git a/scsh/CSAN/SPAN-client.scm b/scsh/CSAN/CSAN-client.scm similarity index 100% rename from scsh/CSAN/SPAN-client.scm rename to scsh/CSAN/CSAN-client.scm diff --git a/scsh/CSAN/SPAN.scm b/scsh/CSAN/CSAN.scm similarity index 100% rename from scsh/CSAN/SPAN.scm rename to scsh/CSAN/CSAN.scm diff --git a/scsh/CSAN/SPAN-server-daemon-record.scm b/scsh/CSAN/SPAN-server-daemon-record.scm deleted file mode 100644 index 9369105..0000000 --- a/scsh/CSAN/SPAN-server-daemon-record.scm +++ /dev/null @@ -1,42 +0,0 @@ -;;; CSAN-server-daemon-record.scm - records for CSAN 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 :CSAN-daemon-record - (make-record-type 'CSAN-daemon-record - '(hostname port sock motd ack bye))) -(define make-CSAN-daemon-record - (record-constructor :CSAN-daemon-record - '(hostname port sock motd ack bye))) - -(define hostname (record-accessor :CSAN-daemon-record 'hostname)) -(define port (record-accessor :CSAN-daemon-record 'port)) -(define sock (record-accessor :CSAN-daemon-record 'sock)) -(define motd (record-accessor :CSAN-daemon-record 'motd)) -(define ack (record-accessor :CSAN-daemon-record 'ack)) -(define bye (record-accessor :CSAN-daemon-record 'bye)) - diff --git a/scsh/CSAN/SPAN-server-daemon.scm b/scsh/CSAN/SPAN-server-daemon.scm deleted file mode 100644 index 5eb0a0c..0000000 --- a/scsh/CSAN/SPAN-server-daemon.scm +++ /dev/null @@ -1,105 +0,0 @@ -;;; 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. - -;; NOTE : files stored on this server are retrieved from its runtime directory - -(load "CSAN-server-daemon-record.scm") - -(define (errormsg) (display " message not understood. ")) -(define (eoln) (string #\newline)) -(define (servermsg) (display "::message::")) - -(define (get-package package-name) - (let* ((in (open-input-file (if (string<=? ".tar.gz" package-name) - package-name - (string-append package-name ".tar.gz")))) - (contents "")) - (do ((c (read-char in) (read-char in))) - ((eof-object? c)contents) - (set! contents (string-append contents (string c)))))) - -(define (run-daemon-child-CSAN 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 CSAN 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 (get-package answer2) out))) - ((or (eq? 'QUIT answer)(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 - "CSAN server side ready." - "Scheming..." - "CSAN server signing off." - )) - -(run-daemon-child-CSAN rc) diff --git a/scsh/CSAN/SPAN-server.scm b/scsh/CSAN/SPAN-server.scm deleted file mode 100644 index 81076d8..0000000 --- a/scsh/CSAN/SPAN-server.scm +++ /dev/null @@ -1,39 +0,0 @@ -;;; server.scm - a full-duplex connect-to-client -;;; -;;; Copyright (c) 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 (CSAN-tell-client request port-number sock) - (call-with-values - (lambda () - (socket-accept sock)) - (lambda (in out) - (display request out) - (close-output-port out) - (let ((answer (make-string-input-port in))) ; returns any server response into some string - (close-input-port in) - answer) - ))) diff --git a/scsh/CSAN/SPAN-util.scm b/scsh/CSAN/SPAN-util.scm deleted file mode 100644 index 0103ae3..0000000 --- a/scsh/CSAN/SPAN-util.scm +++ /dev/null @@ -1,74 +0,0 @@ -;;; CSAN-util.scm - Compehensive Scheme Archive Network utilities -;;; -;;; Copyright (c) 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 (url-bite-off url) - (let ((s "") - (do ((i 0 (+ i 1))) - ((or (>= i (string-length url)) - (eq? (string-ref url i) #\/) - (eq? (string-ref url i) #\\)) ;; needs scheme URL parsing (e.g. with regexps or other perl things - s) - (set! s (string-append s (string (string-ref url i))))) - (if (or (eq? s "http://")(eq? s "ftp://")) - (set! s ""))))) - -(define CSAN-generators (make-table)) -(table-set! CSAN-generators "helpfile" (lambda () - (display "Type in your helpfile : commands are 'get ' and 'h'") - (let ((*out (open-outputfile (string-append "/help")))) - (do ((s (read)(read))) - ((eof-object? s)0) - (write s)(write " "))))) - -(define (CSAN-shell-spawn CSAN-dir mirror) - (newline) - (display "span> ") - (do ((s (read)(read))) - ((null? s)0) - (newline) - (display "span> ") - (cond ((symbol? s) - (cond ((string<=? (symbol->string s)(string #\return)) - 0) - ((string=? "h" (symbol->string s)) - (display "Generating helpfile...")(newline) - (let ((*helpfilename (string-append CSAN-dir "/help"))) - (let ((*in (if (file-exists? *helpfilename) - (open-input-file *helpfilename) - (begin - (display "no helpfile...") - ((CSAN-generate "helpfile")))))) - (for-each write (read *in)))) - 0) - ((string<=? "get" (symbol->string s)) - (display "enter package to fetch : ") - (CSAN-ask-server (string-append "get " (symbol->string (read))) - (url-bite-off mirror) 6969)) - )) - )) - (display "span> signing off."))