sftp.scm: Add high-level API for remote files

* modules/ssh/sftp.scm (call-with-remote-input-file)
  (call-with-remote-output-file, with-input-from-remote-file)
  (with-output-to-remote-file): New procedures.
* doc/api-sftp.texi: Update.

1 files changed, 87 insertions, 1 deletions

diff --git a/modules/ssh/sftp.scm b/modules/ssh/sftp.scm
index e5e812b..3347c9f 100644
--- a/modules/ssh/sftp.scm
+++ b/modules/ssh/sftp.scm
@@ -23,6 +23,7 @@
 ;;; Code:
 
 (define-module (ssh sftp)
+  #:use-module (ice-9 receive)
   #:export (sftp-session?
             make-sftp-session
             sftp-init
@@ -42,7 +43,13 @@
 
             ;; File ports
             sftp-open-file
-            sftp-file?))
+            sftp-file?
+
+            ;; High-level operations on remote files
+            call-with-remote-input-file
+            call-with-remote-output-file
+            with-input-from-remote-file
+            with-output-to-remote-file))
 
 
 ;;; Low-level SFTP session procedures.
@@ -135,6 +142,85 @@ Throw 'guile-ssh-error' on an error."
   (%gssh-sftp-file? x))
 
 
+;;; High-Level operations on remote files.
+;; Those procedures are partly based on GNU Guile's 'r4rs.scm'; the goal is to
+;; provide a convenient API similar to Guile I/O API.
+
+(define (with-input-from-port port thunk)
+  (let ((swaports (lambda () (set! port (set-current-input-port port)))))
+    (dynamic-wind swaports thunk swaports)))
+
+(define (with-output-to-port port thunk)
+  (let ((swaports (lambda () (set! port (set-current-output-port port)))))
+    (dynamic-wind swaports thunk swaports)))
+
+
+(define (call-with-remote-input-file sftp-session filename proc)
+  "Call a PROC with a remote file port opened for input using an SFTP-SESSION.
+PROC should be a procedure of one argument, FILENAME should be a string naming
+a file.  The behaviour is unspecified if a file already exists.
+
+The procedure calls PROC with one argument: the port obtained by opening the
+named remote file for input.
+
+If the procedure returns, then the port is closed automatically and the values
+yielded by the procedure are returned.  If the procedure does not return, then
+the port will not be closed automatically unless it is possible to prove that
+the port will never again be used for a read or write operation."
+  (let ((input-file (sftp-open-file sftp-session filename O_RDONLY)))
+    (call-with-values
+        (lambda () (proc input-file))
+      (lambda vals
+        (close-port input-file)
+        (apply values vals)))))
+
+(define (call-with-remote-output-file sftp-session filename proc)
+  "Call a PROC with a remote file port opened for output using an
+SFTP-SESSION.  PROC should be a procedure of one argument, FILENAME should be
+a string naming a file.  The behaviour is unspecified if a file already
+exists.
+
+The procedure calls PROC with one argument: the port obtained by opening the
+named remote file for output.
+
+If the procedure returns, then the port is closed automatically and the values
+yielded by the procedure are returned.  If the procedure does not return, then
+the port will not be closed automatically unless it is possible to prove that
+the port will never again be used for a read or write operation."
+  (let ((output-file-port (sftp-open-file sftp-session filename
+                                          (logior O_WRONLY O_CREAT))))
+    (call-with-values
+        (lambda () (proc output-file-port))
+      (lambda vals
+        (close-port output-file-port)
+        (apply values vals)))))
+
+
+(define (with-input-from-remote-file sftp-session filename thunk)
+  "THUNK must be a procedure of no arguments, and FILENAME must be a string
+naming a file.  The file must already exist. The file is opened for input, an
+input port connected to it is made the default value returned by
+'current-input-port', and the THUNK is called with no arguments.  When the
+THUNK returns, the port is closed and the previous default is restored.
+Returns the values yielded by THUNK.  If an escape procedure is used to escape
+from the continuation of these procedures, their behavior is implementation
+dependent."
+  (call-with-remote-input-file sftp-session filename
+    (lambda (p) (with-input-from-port p thunk))))
+
+(define (with-output-to-remote-file sftp-session filename thunk)
+  "THUNK must be a procedure of no arguments, and FILENAME must be a string
+naming a file.  The effect is unspecified if the file already exists.  The
+file is opened for output, an output port connected to it is made the default
+value returned by 'current-output-port', and the THUNK is called with no
+arguments.  When the THUNK returns, the port is closed and the previous
+default is restored.  Returns the values yielded by THUNK.  If an escape
+procedure is used to escape from the continuation of these procedures, their
+behavior is implementation dependent."
+  (call-with-remote-output-file sftp-session filename
+    (lambda (p) (with-output-to-port p thunk))))
+
+
 ;;; Load libraries.
 
 (load-extension "libguile-ssh" "init_sftp_session")