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

* minor changes in the comments 

* transfer mode: 'ascii and 'text denote the same
* readding date->string call to the log-call in ftp:connect
* changed calls to netrc:lookup-{login, password} in ftp:login as the
  netrc module works now properly
* correcting minor bug in ftp:build-command-string
This commit is contained in:
interp 2002-02-12 11:47:13 +00:00
parent 5be3a20f9b
commit 2b75e4feee
1 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
ftp.scm
View File

@ -1,6 +1,6 @@
;;; ftp.scm -- an FTP client library for the Scheme Shell ;;; ftp.scm -- an FTP client library for the Scheme Shell
;; ;;
;; $Id: ftp.scm,v 1.2 2001/11/15 11:12:23 mainzelm Exp $ ;; $Id: ftp.scm,v 1.3 2002/02/12 11:47:13 interp Exp $
;; ;;
;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr> ;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
@ -31,9 +31,9 @@
;; ;;
;; (ftp:type connection type) -> status ;; (ftp:type connection type) -> status
;; Change the transfer mode for future data connections. This may ;; Change the transfer mode for future data connections. This may
;; be either 'ascii, for transfering text files, or 'binary for ;; be either 'ascii or 'text, respectively, for transfering text files,
;; transfering binary files. If type is a string it is sent ;; or 'binary for transfering binary files. If type is a string it
;; verbatim to the server. ;; is sent verbatim to the server.
;; ;;
;; (ftp:rename connection oldname newname) -> status ;; (ftp:rename connection oldname newname) -> status
;; Change the name of oldname on the remote host to newname ;; Change the name of oldname on the remote host to newname
@ -219,8 +219,8 @@
LOG "" ""))) LOG "" "")))
(ftp:log connection (ftp:log connection
(format #f "~%-- ~a: opened ftp connection to ~a" (format #f "~%-- ~a: opened ftp connection to ~a"
;; (date->string (date)) (date->string (date)) ; doesn't seem to be buggy in v0.6
"Dummy date" ; (format-time-zone) is buggy in v0.5.1 ;"Dummy date" ; (format-time-zone) is buggy in v0.5.1
hostname)) hostname))
(ftp:read-response connection "220") ; the initial welcome banner (ftp:read-response connection "220") ; the initial welcome banner
connection))) connection)))
@ -231,29 +231,30 @@
;; default to login "anonymous" with password user@host. ;; default to login "anonymous" with password user@host.
;;: connection [ x string x password ] -> status ;;: connection [ x string x password ] -> status
(define (ftp:login connection . args) (define (ftp:login connection . args)
(let ((netrc-record (netrc:parse)))
(let-optionals* args (let-optionals* args
((login ((login
;; (netrc:lookup-login (ftp-connection:host-name connection)) (netrc:lookup-login netrc-record
"anonymous") (ftp-connection:host-name connection)))
(password (password
;;(netrc:lookup-password (netrc:lookup-password netrc-record
;; (ftp-connection:host-name connection)) (ftp-connection:host-name connection))))
(user-mail-address)))
(set-ftp-connection:login connection login) (set-ftp-connection:login connection login)
(set-ftp-connection:password connection password) (set-ftp-connection:password connection password)
(ftp:send-command connection (format #f "USER ~a" login) "...") ; "331" (ftp:send-command connection (format #f "USER ~a" login) "...") ; "331"
(ftp:send-command connection (format #f "PASS ~a" password) "2.."))) ; "230" (ftp:send-command connection (format #f "PASS ~a" password) "2.."))) ; "230"
;; Type must be one of 'binary or 'text, or a string which will be ;; Type must be one of 'binary or 'text or 'ascii, or a string which will be
;; sent verbatim ;; sent verbatim
;;: connection x symbol|string -> status ;;: connection x symbol|string -> status
(define (ftp:type connection type) (define (ftp:type connection type)
(let ((ttype (cond (let ((ttype (cond
((string? type) type) ((string? type) type)
((eq? type 'binary) "I") ((eq? type 'binary) "I")
((eq? type 'text) "A") ((or (eq? type 'ascii)
(eq? type 'text)) "A")
(else (else
(call-error "type must be one of 'binary or 'text" ftp:type type))))) (call-error "type must be one of 'binary or 'text or 'ascii" ftp:type type)))))
(ftp:send-command connection (format #f "TYPE ~a" ttype)))) (ftp:send-command connection (format #f "TYPE ~a" ttype))))
;;: connection x string x string -> status ;;: connection x string x string -> status
@ -561,7 +562,7 @@
response))) response)))
(define (ftp:build-command-string str opt-args) (define (ftp:build-command-string str . opt-args)
(let-optionals* opt-args ((arg #f)) (let-optionals* opt-args ((arg #f))
(if arg (if arg
(string-join (list str arg)) (string-join (list str arg))