tests: Add test for ssh support.

* tests/gpgscm/tests.scm (path-expand): New function.
* tests/openpgp/Makefile.am (TESTS): Add new test.
(sample_keys): Add new keys.
(CLEANFILES): Clean ssh socket and control file.
* tests/openpgp/fake-pinentry.c (main): Add a default passphrase.
* tests/openpgp/gpg-agent.conf.tmpl: Enable ssh support.
* tests/openpgp/samplekeys/ssh-dsa.key: New file.
* tests/openpgp/samplekeys/ssh-ecdsa.key: Likewise.
* tests/openpgp/samplekeys/ssh-ed25519.key: Likewise.
* tests/openpgp/samplekeys/ssh-rsa.key: Likewise.
* tests/openpgp/ssh.scm: Likewise.

Signed-off-by: Justus Winter <justus@g10code.com>

tests/gpgscm/tests.scm

@@ -183,10 +183,12 @@
 (define (in-srcdir what)
   (canonical-path (string-append (getenv "srcdir") "/" what)))
 
-(define (with-path name)
-  (let loop ((path (string-split (getenv "GPGSCM_PATH") #\:)))
+;; Try to find NAME in PATHS.  Returns the full path name on success,
+;; or raises an error.
+(define (path-expand name paths)
+  (let loop ((path paths))
     (if (null? path)
-	name
+	(throw "Could not find" name "in" paths)
 	(let* ((qualified-name (string-append (car path) "/" name))
 	       (file-exists (call-with-input-file qualified-name
 			      (lambda (x) #t))))
@@ -194,6 +196,12 @@
 	      qualified-name
 	      (loop (cdr path)))))))
 
+;; Expand NAME using the gpgscm load path.  Use like this:
+;;   (load (with-path "library.scm"))
+(define (with-path name)
+  (catch name
+	 (path-expand name (string-split (getenv "GPGSCM_PATH") *pathsep*))))
+
 (define (basename path)
   (let ((i (string-index path #\/)))
     (if (equal? i #f)

tests/openpgp/Makefile.am

@@ -81,6 +81,7 @@ TESTS = setup.scm \
 	use-exact-key.scm \
 	default-key.scm \
 	export.scm \
+	ssh.scm \
 	issue2015.scm \
 	finish.scm
 
@@ -145,7 +146,11 @@ sample_keys = samplekeys/README \
 	      samplekeys/E657FB607BB4F21C90BB6651BC067AF28BC90111.asc \
               samplekeys/rsa-rsa-sample-1.asc \
               samplekeys/ed25519-cv25519-sample-1.asc \
-	      samplekeys/silent-running.asc
+	      samplekeys/silent-running.asc \
+	      samplekeys/ssh-dsa.key \
+	      samplekeys/ssh-ecdsa.key \
+	      samplekeys/ssh-ed25519.key \
+	      samplekeys/ssh-rsa.key
 
 EXTRA_DIST = defs.inc defs.scm pinentry.sh $(TESTS) $(TEST_FILES) \
 	     mkdemodirs signdemokey $(priv_keys) $(sample_keys)   \
@@ -157,7 +162,7 @@ CLEANFILES = prepared.stamp x y yy z out err  $(data_files) \
 	     pubring.gpg pubring.gpg~ pubring.kbx pubring.kbx~ \
 	     secring.gpg pubring.pkr secring.skr \
 	     gnupg-test.stop random_seed gpg-agent.log tofu.db \
-	     passphrases
+	     passphrases sshcontrol S.gpg-agent.ssh
 
 clean-local:
 	-rm -rf private-keys-v1.d openpgp-revocs.d tofu.d gpgtar.d

tests/openpgp/fake-pinentry.c

@@ -219,7 +219,11 @@ main (int argc, char **argv)
         *p = 0;
     }
   else
-    passphrase = skip_options (args);
+    {
+      passphrase = skip_options (args);
+      if (*passphrase == 0)
+        passphrase = "no PINENTRY_USER_DATA -- using default passphrase";
+    }
 
   reply ("# fake-pinentry started.  Passphrase='%s'.\n", passphrase);
   reply ("OK - what's up?\n");

tests/openpgp/gpg-agent.conf.tmpl

@@ -1,2 +1,3 @@
 allow-preset-passphrase
 no-grab
+enable-ssh-support

tests/openpgp/samplekeys/ssh-dsa.key

@@ -0,0 +1,12 @@
+-----BEGIN DSA PRIVATE KEY-----
+MIIBvAIBAAKBgQCx0bAMKBKzYJugVtUFRRiF8jV4eT8mowj5C0q4QRPuPAGgPdqq
+g1PKmoIpCKLynqH29+BFErp1OOenWKRdu9claTu0lmIrMYeYw8liKsyMTg5/DxoV
+sRXD1DFoKdeZPDVUxOEQWsLf/IuuLXy4c9GxzET88wUDeieV+GcYQFADoQIVAKS7
+giO+VWOnwqr0p/csUWltpo8TAoGBAJcVpe9riXRuxJtmy1sbJJzOvtPtXk5MCpGs
+T/KEXJuVZvu334zkySDd9Is1ML2g5e81ONRCgCGHpwNOzoLC4+yp+pr1E+B2xkUY
+ouEtZWhKlbaYw7UdHiRRMEVJqvu+CdyI2gwOveDSrVhoXmGyz9PQVNoiuRXP2hMF
+C21jNnBrAoGBAILRAY0/mqsaOTII3uC8KvqwbKlmPnYMJr0COmU1PbOXvaeyWLqG
+NHhwPZg6OEhqEk+WMIwb2Dcv70AIYKQU8jX0elh0lk6pE8bomn7/ZIkqa60VG1Cx
+8x2GUNag78LvnLfmUPAXOrrCPfbGuqdogCymUz1qrtEzdOSbeBvCMAAFAhQr1sV4
++UWhlUoExLMDdIyT/ohfxQ==
+-----END DSA PRIVATE KEY-----

tests/openpgp/samplekeys/ssh-ecdsa.key

@@ -0,0 +1,5 @@
+-----BEGIN EC PRIVATE KEY-----
+MHcCAQEEIF8Mt42n5l2eJB2rk5TSnS98xAtR2VfmmI96WT5OtFrdoAoGCCqGSM49
+AwEHoUQDQgAEsphhghltvEj+1rFEcIlSNy2ze7IMHdhGsH060PwOzjKTy15M8zHI
+uaH9SOMXTzn3Bial8bxrXLsOYEhRZhYSrA==
+-----END EC PRIVATE KEY-----

tests/openpgp/samplekeys/ssh-ed25519.key

@@ -0,0 +1,7 @@
+-----BEGIN OPENSSH PRIVATE KEY-----
+b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW
+QyNTUxOQAAACARyDcsgSrXAdihOuO5lN+qVKVPdwsXCmOZ61XYVUA1MAAAAJAOqdhVDqnY
+VQAAAAtzc2gtZWQyNTUxOQAAACARyDcsgSrXAdihOuO5lN+qVKVPdwsXCmOZ61XYVUA1MA
+AAAEATyEkvuhAExcEet+Rc2Qz2Fxg4iIi4XXJLpZFKwWsY3hHINyyBKtcB2KE647mU36pU
+pU93CxcKY5nrVdhVQDUwAAAACHRlc3Qga2V5AQIDBAU=
+-----END OPENSSH PRIVATE KEY-----

tests/openpgp/samplekeys/ssh-rsa.key

@@ -0,0 +1,27 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIIEpgIBAAKCAQEAxp4sIUtrNBl4Vbd4075CmtHmwxTc0FhQIGw36kptbrWReLb9
+Np0RQylKyc6qUruxZlCdPVFo7iX3vs272/0GEakPv0DAsKGbe1nTsMyxxz0o3dP4
+JQOlOGEnpETa0ybfPLMX1+qNiBdm7HLjqcP5+S0Exb0Z0deFNIhEP6XckUEgHmwA
+/AdDdUUKwwvZeZOi4XyBVt0vXzwM/+84ro27O+CZm9Du3qe1jTIsX7jUrqsUBhp9
+eUwa1jXfXuJJo9b4/GeP4S9x8U7ho+BQ6/HH03dzcKaY3FftanCZkcwxfGBBUiCK
+pIA5WgKimLcgP2R75Y3jilDoBh5HyIdGXo0aFwIDAQABAoIBAQCBXLIHeXS4eUJc
+KeSjnQ8KgV4Yf3UWqf5+L533lkRSUCYQhrbDpGeC49kXOejLe/4eUrEnJ+f8/HOx
+LZSGwvT5+bAM9CLMqGV5YNc1Fw1PZHFCkfXUPdyVrQnBvyr7Th0mDsuf0OAf3IYn
+yOipQMCGX6D1HaY8e3AB+CLjhab0X1vAwvqzPb/HIdtMhRWlJxzbuqnE3kr+Ccvz
+us3vmD4VBp0CF0f+yblcibMCHdHY6j8Ir6Qeq6Mbd6lEXRPW1TgUqP15idVaJ4AF
+1kGXDW9O0ycgrbopGZfk5yY60fEHGdr4QYjx2Gtx2xQcnPcjJ+j5kGgubKWxNhJE
+Qx7DPdYxAoGBAP29S+wD1df0U+Tr0x06N6M/nSjNacGs12Oq/ehNJHhTYUO9fWUl
+M2X/MXRMMMGsnGaLNsrLao9Jnq0ZU5GFICWYeVBvaCvRrGngbqJBy8jRv+QYyaQs
+AckLcdgLGvjhcXonHDcbcxpug7/qFwakT+KY2s11FrHBEzbAIuDiSSKfAoGBAMhj
+KPkrjWJh3xxpFrFnGYj5aF86ExrPe2LAP/8F6Ez7dQN+4bA6O5F4hpJ/X0q/6s0n
+IBljo/DgARCBjbwDSaAMEWdm8HDeBhJsSCdQHW38ylaRDi8CQDKR60N3a/tV1MRJ
+4fKoHZ+7HH3wc+Bjv3oDovwVyUMG7ekCjeqbqI2JAoGBAOkhYX5Jz9KJBAPSwLeb
+4760FfuFL+PooEVMt9kV96ouQbFxiqLB2UWfgJqv3iQ0Kcb1pbQRzag1Jfs4x9Vu
+ESk5vEyw729DSDxHHp8qAMhUHxC9zZZvcHx9bW3oVjHRQOfQw1XGfK0OWTKdK+bI
+VTWG55HaQK21DahCREmG31dVAoGBALBH80KHmsAioziGBi2YKjGCXtvu5eGfBsdP
+orzBQKOATmb91qLGB6MoaRI1NOo4POGu+qD7M7xyAt23aq0sIzfFhgX1260e1C6e
+zTawVsNsL7/JqbWXAEy8az+VrguTbTIkYL2sQStEWoM75WRPu6El09p5e+0YCnEC
+C0CJINUpAoGBAPF1fpPINHlUW+Bvo4Nj3935QgZI47yTplDusptyfYgFYXw6ZYel
+y5Zgv9TWZlmW9FDTp4XVgn5zQTEN1LdL7vNXWV9aOvfrqPk5ClBkxhndgq7j6MFs
+9+9V06HJDIsSrC0D/ajIkP+iT9Hd6eEZMkJ6y6XtTbkJGYt2zOtnrpb6
+-----END RSA PRIVATE KEY-----

tests/openpgp/ssh.scm

@@ -0,0 +1,52 @@
+#!/usr/bin/env gpgscm
+
+;; Copyright (C) 2016 g10 Code GmbH
+;;
+;; This file is part of GnuPG.
+;;
+;; GnuPG 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.
+;;
+;; GnuPG 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/>.
+
+(load (with-path "defs.scm"))
+
+(define GNUPGHOME (getenv "GNUPGHOME"))
+(if (string=? "" GNUPGHOME)
+    (error "GNUPGHOME not set"))
+
+(setenv "SSH_AUTH_SOCK" (path-join GNUPGHOME "S.gpg-agent.ssh") #t)
+
+(define SSH-ADD #f)
+(catch (skip "ssh-add not found")
+       (set! SSH-ADD
+	     (path-expand "ssh-add" (string-split (getenv "PATH") *pathsep*))))
+
+(define keys
+  '(("dsa" "MD5:9a:e1:f1:5f:46:ea:a5:06:e1:e2:f8:38:8e:06:54:58")
+    ("rsa" "MD5:c9:85:b5:55:00:84:a9:82:5a:df:d6:62:1b:5a:28:22")
+    ("ecdsa" "MD5:93:37:30:a6:4e:e7:6a:22:79:77:8e:bf:ed:14:e9:8e")
+    ("ed25519" "MD5:08:df:be:af:d2:f5:32:20:3a:1c:56:06:be:31:0f:bf")))
+
+(for-each-p'
+ "Importing ssh keys..."
+ (lambda (key)
+   (let ((file (path-join (in-srcdir "samplekeys")
+			  (string-append "ssh-" (car key) ".key")))
+	 (hash (cadr key)))
+     ;; We pipe the key to ssh-add so that it won't complain about
+     ;; file's permissions.
+     (pipe:do
+      (pipe:open file (logior O_RDONLY O_BINARY))
+      (pipe:spawn `(,SSH-ADD -)))
+     (unless (string-contains? (call-popen `(,SSH-ADD -l "-E" md5) "") hash)
+	     (error "key not added"))))
+ car keys)