- call FTP-LOGIN from FTP-CONNECT

- don't store login and password in connection record
- don't try to use password if USER succeeds already
- allow port (instead of file) for logging
- fix protocol bugs between FTP-LS/FTP-DIR and FTP-BUILD-COMMAND-STRING

scheme/lib/ftp.scm

@@ -85,15 +85,19 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; beware, the log file contains password information!
-;;: string [ x string x port] -> connection
-(define (ftp-connect host . args)
+
+(define (ftp-connect host login password passive? . args)
   (let-optionals* args ((logfile #f))
-    (let* ((LOG (and logfile
-		     (open-output-file logfile
-				       (if (file-exists? logfile)
-					   (bitwise-ior open/write open/append)
-					   (bitwise-ior open/write open/create))
-				       #o600)))
+    (let* ((log (cond
+		 ((output-port? logfile)
+		  logfile)
+		 ((string? logfile)
+		  (open-output-file logfile
+				    (if (file-exists? logfile)
+					(bitwise-ior open/write open/append)
+					(bitwise-ior open/write open/create))
+				    #o600))
+		 (else #f)))
 	   (hst-info (host-info host))
 	   (hostname (host-info:name hst-info))
 	   (srvc-info (service-info "ftp" "tcp"))
@@ -103,32 +107,38 @@
 				 (service-info:port srvc-info)))
 	   (connection (make-ftp-connection hostname
 					    sock
-					    LOG "" "")))
+					    passive?
+					    log)))
       (ftp-log connection
 	       (format #f "~%-- ~a: opened ftp connection to ~a"
 		       (date->string (date))
 		       hostname))
       (ftp-read-reply connection (exactly-code "220")) ; the initial welcome banner
+      (ftp-login connection login password)
       connection)))
 
-;; Send user information to the remote host. Args are optional login
+;; Send user information to the remote host. Args are login
 ;; and password. If they are not provided, the Netrc module is used to
-;; try to determine a login and password for the server. If not found we
-;; default to login "anonymous" with password user@host.
-;;: connection [ x string x password ] -> status
-(define (ftp-login connection . args)
-  (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) any-code)  ; "331"
-    (ftp-send-command connection (format #f "PASS ~a" password))))) ; "230"
+;; try to determine a login and password for the server.
+
+(define (ftp-login connection login password)
+  (let* ((netrc-record (netrc-parse))
+	 (login (or login
+		    (netrc-lookup-login netrc-record 
+					(ftp-connection-host-name connection))))
+	 (password (or password
+		       (netrc-lookup-password netrc-record 
+					      (ftp-connection-host-name connection)))))
+    (let ((reply
+	   (ftp-send-command connection (ftp-build-command-string "USER" login)
+			     (lambda (code)
+			       (or (string=? code "331") ; "User name okay, need password."
+				   (string=? code "230")))))) ; "User logged in, proceed."
+					     
+      (if (string-prefix? "331" reply)	; "User name okay, need password."
+	  (ftp-send-command connection
+			    (ftp-build-command-string "PASS" password)
+			    (exactly-code "230"))))))
 
 ;; Type must be one of 'binary or 'text or 'ascii, or a string which will be
 ;; sent verbatim
@@ -241,7 +251,7 @@
 (define (ftp-ls connection . maybe-dir)
   (let* ((sock (ftp-open-data-connection connection)))
     (ftp-send-command connection
-                      (ftp-build-command-string "NLST" maybe-dir)
+                      (apply ftp-build-command-string "NLST" maybe-dir)
                       (code-with-prefix "1"))
     (receive (newsock newsockaddr)
 	(accept-connection sock)
@@ -255,7 +265,7 @@
 (define (ftp-dir connection . maybe-dir)
   (let* ((sock (ftp-open-data-connection connection)))
     (ftp-send-command connection
-                      (ftp-build-command-string "LIST" maybe-dir)
+                      (apply ftp-build-command-string "LIST" maybe-dir)
                       (code-with-prefix "1"))
     (receive (newsock newsockaddr)
 	(accept-connection sock)
@@ -347,13 +357,12 @@
 ;; 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-type ftp-connection :ftp-connection
-  (make-ftp-connection host-name command-socket logfd login password)
+  (make-ftp-connection host-name command-socket passive-mode? logfd)
   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!))
+  (passive-mode? ftp-connection-passive-mode?)
+  (logfd ftp-connection-logfd))
 
 (define-condition-type 'ftp-error '(error))
 (define ftp-error? (condition-predicate 'ftp-error))