suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added authenticate-user

Browse Source 
original commit: 3f935beecb5260299444cbe081e143ebcfd5ad36
This commit is contained in:
Eli Barzilay 2004-05-11 16:30:17 +00:00
parent 482ab34c78
commit 0d7c4a4e03
1 changed files with 33 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/net/nntp-unit.ss
View File

@ -32,6 +32,7 @@
(define-struct (article-not-in-group nntp) (article))
(define-struct (no-group-selected nntp) ())
(define-struct (article-not-found nntp) (article))
(define-struct (authentication-rejected nntp) ())
;; signal-error :
;; (exn-args ... -> exn) x format-string x values ... ->
@ -108,6 +109,38 @@
code response)
code response))))))
;; authenticate-user :
;; communicator x user-name x password -> ()
;; the password is not used if the server does not ask for it.
(define authenticate-user
(lambda (communicator user password)
(define (reject code response)
((signal-error make-authentication-rejected
"authentication rejected (~s ~s)"
code response)))
(define (unexpected code response)
((signal-error make-unexpected-response
"unexpected response for authentication: ~s ~s"
code response)
code response))
(send-to-server communicator "AUTHINFO USER ~a" user)
(let-values (((code response)
(get-single-line-response communicator)))
(case code
((281) (void)) ; server doesn't ask for a password
((381)
(send-to-server communicator "AUTHINFO PASS ~a" password)
(let-values (((code response)
(get-single-line-response communicator)))
(case code
((281) (void)) ; done
((502) (reject code response))
(else (unexpected code response)))))
((502) (reject code response))
(else (reject code response)
(unexpected code response))))))
;; send-to-server :
;; communicator x format-string x list (values) -> ()