- Applied patch from Eric Marsden to remove a "interrupted system call"

bug reported in
  http://groups.google.com/groups?hl=en&ie=ISO-8859-1&oe=ISO-8859-1&selm=m2n0x7ahds.fsf_-_%40linux3.maruska.tin.it
This commit is contained in:
interp 2002-03-19 18:42:23 +00:00
parent 94ffee0ea5
commit 0d645ad83f
1 changed files with 13 additions and 16 deletions

29
ftp.scm
View File

@ -1,6 +1,6 @@
;;; ftp.scm -- an FTP client library for the Scheme Shell
;;
;; $Id: ftp.scm,v 1.3 2002/02/12 11:47:13 interp Exp $
;; $Id: ftp.scm,v 1.4 2002/03/19 18:42:23 interp Exp $
;;
;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
@ -242,7 +242,7 @@
(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"
(ftp:send-command connection (format #f "PASS ~a" password) "2..")))) ; "230"
;; Type must be one of 'binary or 'text or 'ascii, or a string which will be
;; sent verbatim
@ -359,10 +359,9 @@
(receive (newsock newsockaddr)
(accept-connection sock)
(dump (socket:inport newsock))
(let ((status (ftp:read-response connection "2..")))
(close-socket newsock)
(close-socket sock)
status))))
(close-socket newsock)
(close-socket sock)
(ftp:read-response connection "2.."))))
;;: connection [ x string ] -> status
(define (ftp:dir connection . maybe-dir)
@ -373,10 +372,9 @@
(receive (newsock newsockaddr)
(accept-connection sock)
(dump (socket:inport newsock))
(let ((status (ftp:read-response connection "2..")))
(close-socket newsock)
(close-socket sock)
status))))
(close-socket newsock)
(close-socket sock)
(ftp:read-response connection "2.."))))
;; maybe-local may be a filename to which the data should be written,
@ -402,10 +400,10 @@
(accept-connection sock)
(with-current-output-port OUT
(dump (socket:inport newsock)))
(close-socket newsock)
(close-socket sock)
(let ((status (ftp:read-response connection "2..")))
(if (string? local) (close OUT))
(close-socket newsock)
(close-socket sock)
(if (eq? local #f)
(string-output-port-output OUT)
status)))))
@ -563,10 +561,9 @@
(define (ftp:build-command-string str . opt-args)
(let-optionals* opt-args ((arg #f))
(if arg
(string-join (list str arg))
str)))
(if (string? opt-args)
(string-join (list str arg))
str))
(define (ftp:log connection line)
(let ((LOG (ftp-connection:logfd connection)))