forked from syndicate-lang/marketplace-ssh-2014
auth-method syntactic sugar
This commit is contained in:
parent
2fc82642ea
commit
24908f58a9
|
@ -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)
|
||||
(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")))))
|
||||
|
||||
(assert (SshAuthenticationMethodAcceptable (SshAuthMethod-publickey)))
|
||||
(during (Observe (:pattern (SshAuthenticationAcceptable
|
||||
(SshAuthMethod-publickey)
|
||||
(SshAuthRequest-publickey ,(DLit $username) ,(DLit $key))
|
||||
,_))
|
||||
_)
|
||||
(assert (SshAuthenticationAcceptable
|
||||
(SshAuthMethod-publickey)
|
||||
(equal? password "password")))
|
||||
(auth-method (SshAuthMethod-publickey)
|
||||
(SshAuthRequest-publickey username key)
|
||||
(and (equal? username "tonyg")
|
||||
(equal? key (public-key->pieces test-user-public))))))
|
||||
(equal? (->preserve key)
|
||||
(public-key->pieces test-user-public))))
|
||||
|
||||
(during (SshAuthenticatedUser $user-name #"ssh-connection")
|
||||
(run-repl-instance conn-ds user-name))
|
||||
|
|
Loading…
Reference in New Issue