Implementation of scp in Scheme upon the new (ssh sftp) module from Guile-SSH.

sscp.scm

#!/usr/bin/guile \
-e main -s
!#

;;; sscp.scm -- Scheme Secure Copy implementation.

;; Copyright (C) 2015 Artyom V. Poptsov <poptsov.artyom@gmail.com>
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.


;;; Commentary:

;; Just a simple implementation of scp in Scheme that is aimed to show
;; how one could use (ssh sftp) module from Guile-SSH to do such a
;; work.  See <https://github.com/artyom-poptsov/guile-ssh>.
;;
;; NOTE that (ssh sftp) module is not stable yet and the API may
;; change in the future.  If you do want to test this program, you
;; should use 'wip-sftp' branch from the repository.  'sscp.scm' is
;; known to work with commit 93ba7b8 on the branch.

;;; Code:

(use-modules (ssh session)
             (ssh auth)
             (ssh sftp)
             (ice-9 regex)
             (ice-9 rdelim)
             (ice-9 getopt-long))


(define (debug fmt . args)
  (format #t "DEBUG: ~a~%" (apply format #f fmt args)))

(define (print-help-and-exit)
  (display "
Usage: sscp source dest

Example:
  sscp avp@127.0.0.1:/etc/profile profile
")
  (exit 0))


(define %remote-regex
  (make-regexp "(.*)@([0-9]+\\.[0-9]+\\.[0-9]\\.[0-9]+):(.*)"))

(define (cp user host path destination)
  "Copy a file specified by a PATH from HOST to a local DESTINATION."
  (let ((session (make-session #:user user #:host host)))
    (connect! session)
    (userauth-agent! session)
    (let ((sftp-session (make-sftp-session session)))
      (sftp-init sftp-session)
      (let ((remote-file (sftp-open-file sftp-session path O_RDONLY))
            (local-file  (open-output-file destination)))
        (let copy ((line (read-line remote-file)))
          (unless (eof-object? line)
            (write-line line local-file)
            (copy (read-line remote-file))))))))


(define (main args)
  "Entry point."
  (let* ((option-spec  '((help (single-char #\h) (value #f))))
         (options      (getopt-long args option-spec))
         (help-needed? (option-ref options 'help #f))
         (args         (option-ref options '()   #f)))

    (and help-needed?
         (print-help-and-exit))

    (debug "program args: ~a" args)

    (let* ((source      (car args))
           (destination (cadr args)))

      (debug "source: ~a; dest: ~a" source destination)

      (cond
       ((regexp-exec %remote-regex source) =>
        (lambda (match)
          (let ((user (match:substring match 1))
                (host (match:substring match 2))
                (path (match:substring match 3)))
            (debug "user: ~a; host: ~a; path: ~a" user host path)
            (cp user host path destination))))
        (else
         (error "Not supported yet.  :-/" args))))))

;;; sscp.scm ends here.