;;;; remote-mailbox-common.scm ;;;; Kon Lovett, Sep '09 (module remote-mailbox-common (;export ; mailbox-name? check-mailbox-name error-mailbox-name tcp-port-no? check-tcp-port-no error-tcp-port-no hostname? check-hostname error-hostname ; remote-mailbox-default-tcp-port-no remote-mailbox-default-hostname) (import scheme (chicken base) (chicken type) (chicken fixnum) (chicken process-context) (only (srfi 13) string-null?) (only moremacros define-warning-parameter) (only type-errors warning-argument-type) (only type-checks define-check+error-type)) ;; (include-relative "remote-mailbox.types") (: mailbox-name? (* -> boolean : mailbox-name)) (: tcp-port-no? (* -> boolean : tcp-port-no)) (: hostname? (* -> boolean : hostname)) (: remote-mailbox-default-tcp-port-no (#!optional (or boolean fixnum) -> fixnum)) (: remote-mailbox-default-hostname (#!optional (or boolean string) -> string)) ;;; (define-constant DEFAULT-TCP-PORT-NO 63001) (define-constant DEFAULT-HOSTNAME "localhost") (define *environment-variable-tcp-port-no* (get-environment-variable "REMOTE-MAILBOX-TCP-PORT")) (define *environment-variable-hostname* (get-environment-variable "REMOTE-MAILBOX-HOSTNAME")) (define *tcp-port-no* (or *environment-variable-tcp-port-no* DEFAULT-TCP-PORT-NO)) (define *hostname* (or *environment-variable-hostname* DEFAULT-HOSTNAME)) ;; (define mailbox-name? symbol?) (define (tcp-port-no? obj) (and (fixnum? obj) (and (fx< 0 obj) (fx<= obj 65535))) ) (define (hostname? obj) (and (string? obj) (not (string-null? obj))) ) ;; (define-check+error-type mailbox-name) (define-check+error-type tcp-port-no) (define-check+error-type hostname) (define (remote-mailbox-tcp-port-no? x) (or (not x) (tcp-port-no? x))) (define (remote-mailbox-hostname? x) (or (not x) (hostname? x))) ;; Parameters (define-warning-parameter remote-mailbox-default-tcp-port-no *tcp-port-no* remote-mailbox-tcp-port-no ;ugh, automagic identifier injection (unless obj (set! obj *tcp-port-no*)) ) (define-warning-parameter remote-mailbox-default-hostname *hostname* remote-mailbox-hostname ;ugh, automagic identifier injection (unless obj (set! obj *hostname*)) ) ) ;module remote-mailbox-common