scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

- 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
ftp.scm
View File

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