Ray Miller
78beb037e7
* Move remote-cmd from connection to an action module. * Inventory now populates a global variable instead of returning a list. * Added a `describe` method to connections. * Cleaned up execute/continue-on-error etc. * Removed workflow class.
91 lines
3.8 KiB
Scheme
91 lines
3.8 KiB
Scheme
#|
|
|
This file is part of Ordo.
|
|
|
|
Copyright (C) 2025 Ray Miller
|
|
|
|
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, version 3.
|
|
|
|
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 <https://www.gnu.org/licenses/>.
|
|
|#
|
|
|
|
(define-module (ordo connection ssh)
|
|
#:use-module (oop goops)
|
|
#:use-module (ice-9 exceptions)
|
|
#:use-module (ice-9 popen)
|
|
#:use-module (ssh session)
|
|
#:use-module (ssh channel)
|
|
#:use-module (ssh auth)
|
|
#:use-module (ssh popen)
|
|
#:use-module (ssh sftp)
|
|
#:use-module (ordo connection base)
|
|
#:use-module (ordo connection sudo)
|
|
#:use-module (ordo util read-lines)
|
|
#:export (<ssh-connection>))
|
|
|
|
(define-class <ssh-connection> (<sudo-connection>)
|
|
(user #:getter ssh-connection-user #:init-keyword #:user)
|
|
(host #:getter ssh-connection-host #:init-keyword #:host)
|
|
(password #:getter ssh-connection-password #:init-keyword #:password #:init-value #f)
|
|
(identity #:getter ssh-connection-identity #:init-keyword #:identity #:init-value #f)
|
|
(timeout #:getter ssh-connection-timeout #:init-keyword #:timeout #:init-value 10)
|
|
(authenticate-server? #:getter ssh-connection-authenticate-server? #:init-keyword #:authenticate-server? #:init-value #t)
|
|
(session)
|
|
(sftp-session))
|
|
|
|
(define-method (describe (c <ssh-connection>))
|
|
(format #f "ssh ~a@~a (sudo=~a)"
|
|
(ssh-connection-user c)
|
|
(ssh-connection-host c)
|
|
(become? c)))
|
|
|
|
(define-method (setup (c <ssh-connection>))
|
|
(unless (slot-bound? c 'session)
|
|
(let ((s (make-session #:user (ssh-connection-user c) #:host (ssh-connection-host c))))
|
|
(session-set! s 'timeout (ssh-connection-timeout c))
|
|
(when (ssh-connection-identity c)
|
|
(session-set! s 'identity (ssh-connection-identity c)))
|
|
(slot-set! c 'session s)))
|
|
(let ((s (slot-ref c 'session)))
|
|
(unless (connected? s)
|
|
(when (equal? 'error (connect! s))
|
|
(error (string-append "Error connecting to " (ssh-connection-host c))))
|
|
(when (ssh-connection-authenticate-server? c)
|
|
(let ((server-auth (authenticate-server s)))
|
|
(unless (equal? 'ok server-auth)
|
|
(error (format #f "authenticate-server: ~a" server-auth)))))
|
|
(let ((user-auth (if (ssh-connection-password c)
|
|
(userauth-password! s (ssh-connection-password c))
|
|
(userauth-public-key/auto! s))))
|
|
(unless (equal? 'success user-auth)
|
|
(error (format #f "userauth: ~a" user-auth)))))))
|
|
|
|
(define-method (remote-exec (c <ssh-connection>) (command <string>))
|
|
(let* ((channel (open-remote-input-pipe (slot-ref c 'session) command))
|
|
(output (read-lines channel))
|
|
(exit-status (channel-get-exit-status channel)))
|
|
(close channel)
|
|
(values output exit-status)))
|
|
|
|
(define-method (sftp-session (c <ssh-connection>))
|
|
(unless (slot-bound? c 'sftp-session)
|
|
(slot-set! c 'sftp-session (make-sftp-session (session c))))
|
|
(slot-ref c 'sftp-session))
|
|
|
|
(define-method (with-remote-input-file (c <ssh-connection>) (filename <string>) (proc <procedure>))
|
|
(call-with-remote-input-file (sftp-session c) filename proc))
|
|
|
|
(define-method (with-remote-output-file (c <ssh-connection>) (filename <string>) (proc <procedure>))
|
|
(call-with-remote-output-file (sftp-session c) filename proc))
|
|
|
|
(define-method (teardown (c <ssh-connection>))
|
|
(when (slot-bound? c 'session)
|
|
(let ((s (slot-ref c 'session)))
|
|
(when (connected? s)
|
|
(disconnect! s)))))
|