Use DEFINE-RECORD-TYPES instead of DEFREC-PACKAGE in FTP.
This commit is contained in:
parent
6faaa49692
commit
fe96c5f2b2
|
@ -228,12 +228,12 @@
|
|||
(let-optionals* args
|
||||
((login
|
||||
(netrc:lookup-login netrc-record
|
||||
(ftp-connection:host-name connection)))
|
||||
(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-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"
|
||||
|
||||
|
@ -324,7 +324,7 @@
|
|||
;;: connection -> status
|
||||
(define (ftp-quit connection)
|
||||
(ftp-send-command connection "QUIT" "221")
|
||||
(close-socket (ftp-connection:command-socket connection)))
|
||||
(close-socket (ftp-connection-command-socket connection)))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -482,12 +482,14 @@
|
|||
|
||||
;; We cache the login and password to be able to relogin automatically
|
||||
;; if we lose the connection (a la ange-ftp). Not implemented.
|
||||
(define-record ftp-connection
|
||||
host-name
|
||||
command-socket
|
||||
logfd
|
||||
login
|
||||
password)
|
||||
(define-record-type ftp-connection :ftp-connection
|
||||
(make-ftp-connection host-name command-socket logfd login password)
|
||||
ftp-connection?
|
||||
(host-name ftp-connection-host-name)
|
||||
(command-socket ftp-connection-command-socket)
|
||||
(logfd ftp-connection-logfd)
|
||||
(login ftp-connection-login set-ftp-connection-login!)
|
||||
(password ftp-connection-password set-ftp-connection-password!))
|
||||
|
||||
(define-condition-type 'ftp-error '(error))
|
||||
(define ftp-error? (condition-predicate 'ftp-error))
|
||||
|
@ -515,7 +517,7 @@
|
|||
|
||||
(define (ftp-send-command connection command . maybe-expected)
|
||||
(let-optionals* maybe-expected ((expected "2.."))
|
||||
(let* ((sock (ftp-connection:command-socket connection))
|
||||
(let* ((sock (ftp-connection-command-socket connection))
|
||||
(OUT (socket:outport sock)))
|
||||
(write-string command OUT)
|
||||
(write-crlf OUT)
|
||||
|
@ -536,7 +538,7 @@
|
|||
;; server.
|
||||
(define (ftp-read-response connection . maybe-expected)
|
||||
(let-optionals* maybe-expected ((expected "2.."))
|
||||
(let* ((sock (ftp-connection:command-socket connection))
|
||||
(let* ((sock (ftp-connection-command-socket connection))
|
||||
(IN (socket:inport sock))
|
||||
(response (read-line IN)))
|
||||
(ftp-log connection (format #f "-> ~a" response))
|
||||
|
@ -559,7 +561,7 @@
|
|||
str))
|
||||
|
||||
(define (ftp-log connection line)
|
||||
(let ((LOG (ftp-connection:logfd connection)))
|
||||
(let ((LOG (ftp-connection-logfd connection)))
|
||||
(and LOG
|
||||
(write-string line LOG)
|
||||
(write-string "\n" LOG)
|
||||
|
|
|
@ -470,7 +470,7 @@
|
|||
(define-structure ftp ftp-interface
|
||||
(open scheme-with-scsh
|
||||
netrc
|
||||
defrec-package
|
||||
define-record-types
|
||||
receiving
|
||||
handle
|
||||
conditions
|
||||
|
|
Loading…
Reference in New Issue