diff --git a/scsh/SPAN/SPAN-client.scm b/scsh/SPAN/SPAN-client.scm index b957bd3..79035a8 100644 --- a/scsh/SPAN/SPAN-client.scm +++ b/scsh/SPAN/SPAN-client.scm @@ -1,6 +1,6 @@ ;;; client.scm - a full-duplex connect-to-server ;;; -;;; Copyright (c) 2011-2012 Johan Ceuppens +;;; Copyright (c) 2012 Johan Ceuppens ;;; ;;; All rights reserved. ;;; @@ -26,10 +26,10 @@ ;;; (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-ask-server request port-number) +(define (SPAN-ask-server request hostname port) (call-with-values (lambda () - (socket-client (get-host-name) port-number)) + (socket-client hostname port)) (lambda (in out) (display request out) (close-output-port out) diff --git a/scsh/SPAN/SPAN-server.scm b/scsh/SPAN/SPAN-server.scm index 55228b6..005bb6c 100644 --- a/scsh/SPAN/SPAN-server.scm +++ b/scsh/SPAN/SPAN-server.scm @@ -1,6 +1,6 @@ ;;; server.scm - a full-duplex connect-to-client ;;; -;;; Copyright (c) 2011-2012 Johan Ceuppens +;;; Copyright (c) 2012 Johan Ceuppens ;;; ;;; All rights reserved. ;;; diff --git a/scsh/SPAN/SPAN.scm b/scsh/SPAN/SPAN.scm index 787fc37..bc94e01 100644 --- a/scsh/SPAN/SPAN.scm +++ b/scsh/SPAN/SPAN.scm @@ -1,6 +1,6 @@ ;;; SPAN.scm - Scheme Perl Archive Network ;;; -;;; Copyright (c) 2011-2012 Johan Ceuppens +;;; Copyright (c) 2012 Johan Ceuppens ;;; ;;; All rights reserved. ;;; diff --git a/scsh/SPAN/load.scm b/scsh/SPAN/load.scm index 755fb03..6fb1e85 100644 --- a/scsh/SPAN/load.scm +++ b/scsh/SPAN/load.scm @@ -1,6 +1,6 @@ -;;; schemedoc.scm - a scheme perldoc utility +;;; load.scm - a scheme SPAN ;;; -;;; Copyright (c) 2011-2012 Johan Ceuppens +;;; Copyright (c) 2012 Johan Ceuppens ;;; ;;; All rights reserved. ;;; @@ -27,9 +27,14 @@ ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (load "SPAN.scm") +(load "SPAN-client.scm") ;; initialization +;; Commands: +;; h : display help +;; get : fetch file + ;; question 1 (define SPAN-build-and-cache-dir (string-append (getenv "HOME") "/.span")) @@ -147,10 +152,29 @@ #f)) (display SPAN-shell-droptext-22) -(do ((s (read)(read)) - ((and (symbol? s) - (string<=? (symbol->string s)(string #\return))) - 0) - #t)) +(define (url-bite-off url) + (let ((s "") + (do ((i 0 (+ i 1))) + ((>= i (string-length url)) + ;;(if (= (string-ref url i) #\/) + ;; (set! + s) + (set! s (string-append s (string (string-ref url i))))) + (if (or (eq? s "http://")(eq? s "ftp://")) + (set! s ""))))) -(display "Signing off - rest is under dev")) \ No newline at end of file +(do ((s (read)(read))) + ((null? s)0) + (cond ((symbol? s) + (cond ((string<=? (symbol->string s)(string #\return)) + 0) + ((string=? "h" (symbol->string s)) + (display "Commands : get ") + 0) + ((string<=? "get" (symbol->string s)) + (display "enter package to fetch : ") + (SPAN-ask-server (string-append "get " (symbol->string (read))) + (url-bite-off SPAN-mirror-url) 6969)) + )) + )) +(display "Signing off.") \ No newline at end of file