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

37
ftp.scm
View File

@ -1,6 +1,6 @@
;;; 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>
@ -31,9 +31,9 @@
;;
;; (ftp:type connection type) -> status
;; Change the transfer mode for future data connections. This may
;; be either 'ascii, for transfering text files, or 'binary for
;; transfering binary files. If type is a string it is sent
;; verbatim to the server.
;; be either 'ascii or 'text, respectively, for transfering text files,
;; or 'binary for transfering binary files. If type is a string it
;; is sent verbatim to the server.
;;
;; (ftp:rename connection oldname newname) -> status
;; Change the name of oldname on the remote host to newname
@ -219,8 +219,8 @@
LOG "" "")))
(ftp:log connection
(format #f "~%-- ~a: opened ftp connection to ~a"
;; (date->string (date))
"Dummy date" ; (format-time-zone) is buggy in v0.5.1
(date->string (date)) ; doesn't seem to be buggy in v0.6
;"Dummy date" ; (format-time-zone) is buggy in v0.5.1
hostname))
(ftp:read-response connection "220") ; the initial welcome banner
connection)))
@ -231,29 +231,30 @@
;; default to login "anonymous" with password user@host.
;;: connection [ x string x password ] -> status
(define (ftp:login connection . args)
(let-optionals* args
((login
;; (netrc:lookup-login (ftp-connection:host-name connection))
"anonymous")
(password
;;(netrc:lookup-password
;; (ftp-connection:host-name connection))
(user-mail-address)))
(let ((netrc-record (netrc:parse)))
(let-optionals* args
((login
(netrc:lookup-login netrc-record
(ftp-connection:host-name connection)))
(password
(netrc:lookup-password netrc-record
(ftp-connection:host-name connection))))
(set-ftp-connection:login connection login)
(set-ftp-connection:password connection password)
(ftp:send-command connection (format #f "USER ~a" login) "...") ; "331"
(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
;;: connection x symbol|string -> status
(define (ftp:type connection type)
(let ((ttype (cond
((string? type) type)
((eq? type 'binary) "I")
((eq? type 'text) "A")
((or (eq? type 'ascii)
(eq? type 'text)) "A")
(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))))
;;: connection x string x string -> status
@ -561,7 +562,7 @@
response)))
(define (ftp:build-command-string str opt-args)
(define (ftp:build-command-string str . opt-args)
(let-optionals* opt-args ((arg #f))
(if arg
(string-join (list str arg))