scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

SPAN to CSAN name change

This commit is contained in:
erana 2012-01-26 01:58:59 +09:00
parent dc9c38885d
commit 8bd7a8994e
6 changed files with 0 additions and 260 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
scsh/CSAN/SPAN-client.scm → scsh/CSAN/CSAN-client.scm
View File

0
scsh/CSAN/SPAN.scm → scsh/CSAN/CSAN.scm
View File

42
scsh/CSAN/SPAN-server-daemon-record.scm
View File

@ -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))

105
scsh/CSAN/SPAN-server-daemon.scm
View File

@ -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)

39
scsh/CSAN/SPAN-server.scm
View File

@ -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)
)))

74
scsh/CSAN/SPAN-util.scm
View File

@ -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 <filename-on-server>' 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."))