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
	
	 sperber
						sperber