Scheme Secure Shell

sssh.scm

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

;;; sssh.scm -- Scheme Secure Shell.

;; Copyright (C) 2013 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:

;; This program is aimed to demonstrate some features of Guile-SSH
;; library.  See https://github.com/artyom-poptsov/libguile-ssh
;;
;; Current version is tested with Guile-SSH 0.3.1


;;; Code:

(use-modules (ice-9 getopt-long)
             (ssh channel)
             (ssh session)
             (ssh auth)
             (ssh key)
             (ssh version))

(define *program-name* "sssh")

(define *option-spec*
  '((user          (single-char #\u) (value #t))
    (port          (single-char #\p) (value #t))
    (identity-file (single-char #\i) (value #t))
    (help          (single-char #\h) (value #f))
    (debug         (single-char #\d) (value #f))))

;; Handle SSH error.
(define (handle-error session)
  (display (ssh:get-error session))
  (newline)
  (exit))


;; Print information about program usage
(define (print-help)
  (display
   (string-append
    *program-name* " -- Scheme Secure Shell\n"
    "Copyright (C) Artyom Poptsov <poptsov.artyom@gmail.com>\n"
    "Licensed under GNU GPLv3+\n"
    "\n"
    "Usage: " *program-name* " [ -upid ] <host> <command>\n"
    "\n"
    "Options:\n"
    "  -u, --user                User name\n"
    "  -p, --port                Port number\n"
    "  -i, --identity-file       Path to private key\n"
    "  -d, --debug               Debug mode\n")))


;; Entry point of the program
(define (main args)

  (let* ((options       (getopt-long args *option-spec*))
         (user          (option-ref options 'user (getenv "USER")))
         (port          (string->number (option-ref options 'port "22")))
         (identity-file (option-ref options 'identity-file
                                    (string-append
                                     (getenv "HOME") "/.ssh/id_rsa")))
         (debug?        (option-ref options 'debug #f))
         (help-needed?  (option-ref options 'help #f))
         (args          (option-ref options '() #f)))

    (if (or help-needed? (null? args))
        (begin
          (print-help)
          (exit)))

    (format #t "libssh version:       ~a~%" (ssh:get-libssh-version))
    (format #t "libguile-ssh version: ~a~%" (ssh:get-library-version))

    (let ((host (car args))
          (cmd  (cadr args)))

      (display "1. ssh:make-session (ssh_new)\n")
      (let ((session (ssh:make-session)))

        (display "2. ssh:session-set! (ssh_options_set)\n")

        (if (not (ssh:session-set! session 'user user))
            (handle-error session))

        (if (not (ssh:session-set! session 'host host))
            (handle-error session))

        (if (not (ssh:session-set! session 'port port))
            (handle-error session))

        (if (not (ssh:session-set! session 'log-verbosity (if debug? 4 0)))
            (handle-error session))

        (display "3. ssh:connect! (ssh_connect)\n")
        (if (eqv? (ssh:connect! session) 'error)
            (handle-error session))

        (format #t "   Available authentication methods: ~a~%" (ssh:userauth-get-list session))

        (display "4. ssh:authenticate-server (ssh_is_server_known)\n")
        (case (ssh:authenticate-server session)
          ((ok)        (display "   ok\n"))
          ((not-known) (display "   The server is unknown.  Please check MD5.\n")))

        (format #t "   MD5 hash: ~a~%" (ssh:get-public-key-hash session))

        (let ((private-key (ssh:private-key-from-file session identity-file)))

          (if (not private-key)
              (handle-error session))

          (let ((public-key (ssh:private-key->public-key private-key)))

            (format #t "   Key: ~a~%" (ssh:public-key->string public-key))

            (if (not public-key)
                (handle-error session))

            (display "5. ssh:userauth-pubkey! (ssh_userauth_pubkey)\n")
            (if (eqv? (ssh:userauth-pubkey! session #f public-key private-key) 'error)
                (handle-error session))))

        (display "6. ssh:make-channel (ssh_channel_new)\n")
        (let ((channel (ssh:make-channel session)))

          (if (not channel)
              (handle-error session))

          (display "7. ssh:channel-open-session (ssh_channel_open_session)\n")
          (if (not (ssh:channel-open-session channel))
              (handle-error session))

          (display "8. ssh:channel-request-exec (ssh_channel_request_exec)\n")
          (if (not (ssh:channel-request-exec channel (cadr args)))
              (handle-error session))

          (display "9. ssh:channel-poll (ssh_channel_poll)\n")
          (let poll ((count #f))
            (if (or (not count) (zero? count))
                (poll (ssh:channel-poll channel #f))
                (begin
                  (display "10. ssh:channel-read (ssh_channel_read)\n")
                  (let ((result (ssh:channel-read channel count #f)))
                    (if (not result)
                        (handle-error session)
                        (begin
                          (display result)
                          (newline))))))))))))

;;; sssh.scm ends here