commit
d2df49be7e
1 changed files with 66 additions and 0 deletions
@ -0,0 +1,66 @@ |
|||
(use-modules (srfi srfi-1) |
|||
(srfi srfi-13) |
|||
(ice-9 binary-ports) |
|||
(ice-9 textual-ports) |
|||
(ice-9 format) |
|||
(ice-9 regex) |
|||
(rnrs bytevectors)) |
|||
|
|||
(define *host-passwd-file* (getenv "FUDO_HOST_PASSWD_FILE")) |
|||
(when (not *host-passwd-file*) |
|||
(format (current-error-port "FUDO_HOST_PASSWD_FILE not set~%")) |
|||
(exit 1)) |
|||
|
|||
(define *service-passwd-file* (getenv "FUDO_SERVICE_PASSWD_FILE")) |
|||
(when (not *service-passwd-file*) |
|||
(format (current-error-port "FUDO_SERVICE_PASSWD_FILE not set~%")) |
|||
(exit 1)) |
|||
|
|||
(define host-regex "^host-([a-zA-Z][a-zA-Z0-9_-]+)$") |
|||
(define service-regex "^service-([a-zA-Z][a-zA-Z0-9_-]+)$") |
|||
|
|||
(define (make-verifier passwd-file) |
|||
(let ((passwds (load passwd-file))) |
|||
(lambda (username passwd) |
|||
(and (> (string-length passwd) 6) |
|||
(equal? (assoc-ref passwds username) passwd))))) |
|||
|
|||
(define (make-authenticator host-verifier service-verifier) |
|||
(lambda (username hostname password) |
|||
(cond ((string-match host-regex username) |
|||
(host-verifier (match:substring (string-match host-regex username) 1) |
|||
password)) |
|||
|
|||
((string-match service-regex username) |
|||
(service-verifier (match:substring (string-match service-regex username) 1) |
|||
password)) |
|||
|
|||
(else #f)))) |
|||
|
|||
(define (make-handler handlers) |
|||
(lambda (request) |
|||
(let ((op (assoc-ref handlers (first request)))) |
|||
(if op |
|||
(apply op (cdr request)) |
|||
#f)))) |
|||
|
|||
(define (auth-listener handler) |
|||
(let ((in (current-input-port)) |
|||
(out (current-output-port))) |
|||
(while #t |
|||
(let ((size (bytevector-u16-ref (get-bytevector-n in 2) 0 (endianness big))) |
|||
(response (make-bytevector 4 0))) |
|||
(bytevector-u8-set! response 1 #x02) |
|||
(if (handler (string-split (get-string-n in size) #\:)) |
|||
(begin (bytevector-u8-set! response 3 #x01) |
|||
(put-bytevector out response 0 4) |
|||
(force-output out)) |
|||
(begin (bytevector-u8-set! response 3 #x00) |
|||
(put-bytevector out response 0 4) |
|||
(force-output out))))))) |
|||
|
|||
(auth-listener |
|||
(make-handler |
|||
(list (cons "auth" |
|||
(make-authenticator (make-verifier *host-passwd-file*) |
|||
(make-verifier *service-passwd-file*)))))) |
Write
Preview
Loading…
Cancel
Save
Reference in new issue