syndicate-lang
/
syndicate-ssh
forked from syndicate-lang/marketplace-ssh-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

auth-method syntactic sugar

This commit is contained in:
Tony Garnock-Jones 2021-06-21 14:56:12 +02:00
parent 2fc82642ea
commit 24908f58a9
1 changed files with 19 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
syndicate-ssh/new-server.rkt
View File

@ -73,38 +73,26 @@
(log-error "Invalid peer identification string ~v" remote-identification)
(stop-actor-system)])])
(assert (SshAuthenticationMethodAcceptable (SshAuthMethod-none)))
(during (Observe (:pattern (SshAuthenticationAcceptable
(SshAuthMethod-none)
(SshAuthRequest-none ,(DLit $username))
,_))
_)
(assert (SshAuthenticationAcceptable (SshAuthMethod-none)
(SshAuthRequest-none username)
(equal? username "guest"))))
(define-syntax-rule (auth-method m p x)
(begin
(assert (SshAuthenticationMethodAcceptable m))
(during (Observe (:pattern (SshAuthenticationAcceptable m ,(DLit $r) ,_)) _)
(match (parse-SshAuthRequest r)
[p (assert (SshAuthenticationAcceptable m r x))]
[_ (assert (SshAuthenticationAcceptable m r #f))]))))
(assert (SshAuthenticationMethodAcceptable (SshAuthMethod-password)))
(during (Observe (:pattern (SshAuthenticationAcceptable
(SshAuthMethod-password)
(SshAuthRequest-password ,(DLit $username) ,(DLit $password))
,_))
_)
(assert (SshAuthenticationAcceptable (SshAuthMethod-password)
(SshAuthRequest-password username password)
(and (equal? username "user")
(equal? password "password")))))
(assert (SshAuthenticationMethodAcceptable (SshAuthMethod-publickey)))
(during (Observe (:pattern (SshAuthenticationAcceptable
(SshAuthMethod-publickey)
(SshAuthRequest-publickey ,(DLit $username) ,(DLit $key))
,_))
_)
(assert (SshAuthenticationAcceptable
(SshAuthMethod-publickey)
(SshAuthRequest-publickey username key)
(and (equal? username "tonyg")
(equal? key (public-key->pieces test-user-public))))))
(auth-method (SshAuthMethod-none)
(SshAuthRequest-none username)
(equal? username "guest"))
(auth-method (SshAuthMethod-password)
(SshAuthRequest-password username password)
(and (equal? username "user")
(equal? password "password")))
(auth-method (SshAuthMethod-publickey)
(SshAuthRequest-publickey username key)
(and (equal? username "tonyg")
(equal? (->preserve key)
(public-key->pieces test-user-public))))
(during (SshAuthenticatedUser $user-name #"ssh-connection")
(run-repl-instance conn-ds user-name))