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

Use a function instead of a macro

This commit is contained in:
Tony Garnock-Jones 2021-06-21 15:07:10 +02:00
parent 7ae447253d
commit 92bf8d8ed9
1 changed files with 12 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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