1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
| | ;;; Guile-Git --- GNU Guile bindings of libgit2
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of Guile-Git.
;;;
;;; Guile-Git 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.
;;;
;;; Guile-Git 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 Guile-Git. If not, see <http://www.gnu.org/licenses/>.
(define-module (tests ssh)
#:use-module (git auth)
#:use-module (tests helpers)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:export (with-sshd-server
with-ssh-agent
make-client-ssh-auth))
(define sshd "@SSHD@")
(define %ssh-dir (path-join (getenv "srcdir") "/tests/.ssh"))
(define (in-ssh-folder . args)
(apply path-join %ssh-dir args))
(define (start-sshd port)
(define (write-authorized-keys file)
(call-with-output-file file
(lambda (port)
;; We need to pass PATH so that git binary (git-upload-pack) can be
;; found from sshd.
(format port "environment=\"PATH=~a\" ~a"
(getenv "PATH")
(call-with-input-file (in-ssh-folder "id_rsa_client.pub")
read-string)))))
(define (write-sshd-conf conf authorized-keys)
(call-with-output-file conf
(lambda (port)
(format port "AuthorizedKeysFile ~a
PidFile ~a
PermitUserEnvironment yes~%"
authorized-keys
(in-ssh-folder "sshd_pid")))))
(let ((sshd-conf (in-ssh-folder "sshd.conf"))
(sshd-key (in-ssh-folder "id_rsa_server"))
(authorized-keys (in-ssh-folder "authorized_keys")))
(write-authorized-keys authorized-keys)
(write-sshd-conf sshd-conf authorized-keys)
(system* sshd "-p" (number->string port) "-f" sshd-conf "-h" sshd-key)))
(define (stop-sshd)
(define (read-pid port)
(string-trim-right (read-string port) #\newline))
(let ((pid
(call-with-input-file (in-ssh-folder "sshd_pid")
read-pid)))
(system* "kill" pid)))
(define-syntax-rule (with-sshd-server port body ...)
(dynamic-wind
(lambda ()
(start-sshd port))
(lambda ()
body ...)
(lambda ()
(stop-sshd))))
(define %ssh-auth-sock-regexp
(make-regexp "SSH_AUTH_SOCK=(.*); export SSH_AUTH_SOCK;"))
(define %ssh-agent-pid-regexp
(make-regexp "SSH_AGENT_PID=(.*); export SSH_AGENT_PID;"))
(define (start-ssh-agent)
(let* ((p (open-input-pipe "ssh-agent -s"))
(ssh-auth-sock-data (read-line p))
(ssh-agent-pid-data (read-line p))
(sock
(let ((match (regexp-exec %ssh-auth-sock-regexp
ssh-auth-sock-data)))
(match:substring match 1)))
(pid (let ((match (regexp-exec %ssh-agent-pid-regexp
ssh-agent-pid-data)))
(match:substring match 1))))
(setenv "SSH_AUTH_SOCK" sock)
pid))
(define (ssh-agent-add-client-key)
(system* "ssh-add" (in-ssh-folder "id_rsa_client")))
(define-syntax-rule (with-ssh-agent body ...)
(let ((pid (start-ssh-agent)))
(dynamic-wind
(const #f)
(lambda ()
(ssh-agent-add-client-key)
body ...)
(lambda ()
(system* "kill" pid)))))
(define (make-client-ssh-auth)
(%make-auth-ssh-credentials
(in-ssh-folder "id_rsa_client.pub")
(in-ssh-folder "id_rsa_client")))
|