diff --git a/scheme/lib/pop3.scm b/scheme/lib/pop3.scm index b9603c7..c20edcc 100644 --- a/scheme/lib/pop3.scm +++ b/scheme/lib/pop3.scm @@ -153,7 +153,7 @@ (let* ((banner (pop3-read-response connection)) (match (regexp-search (rx (posix-string "\\+OK .* (<[^>]+>)")) banner)) (challenge (and match (match:substring match 1)))) - (set-pop3-connection:challenge connection challenge)) + (set-pop3-connection-challenge! connection challenge)) connection))) @@ -165,23 +165,23 @@ (let ((netrc (and (< (length args) 2) (netrc-parse)))) (let-optionals args - ((login (or (netrc-lookup-login netrc (pop3-connection:host-name connection) #f) + ((login (or (netrc-lookup-login netrc (pop3-connection-host-name connection) #f) (call-error "must provide a login" pop3-login args))) (password (or (netrc-lookup-password netrc - (pop3-connection:host-name connection) #f) + (pop3-connection-host-name connection) #f) (call-error "must provide a password" pop3-login args)))) (with-handler (lambda (result punt) (if (-ERR? result) - (if (pop3-connection:challenge connection) + (if (pop3-connection-challenge connection) (pop3-login/APOP connection login password) (error "login failed")))) (lambda () (pop3-send-command connection (format #f "USER ~a" login)) (pop3-send-command connection (format #f "PASS ~a" password)) - (set-pop3-connection:login connection login) - (set-pop3-connection:password connection password) - (set-pop3-connection:state connection 'connected)))))) + (set-pop3-connection-login! connection login) + (set-pop3-connection-password! connection password) + (set-pop3-connection-state! connection 'connected)))))) ;; Login to the server using APOP authentication (no cleartext @@ -208,14 +208,14 @@ ;; ;;: connection x string x string -> status (define (pop3-login/APOP connection login password) - (let* ((key (string-append (pop3-connection:challenge connection) + (let* ((key (string-append (pop3-connection-challenge connection) password)) (digest (md5-digest key)) (status (pop3-send-command connection (format #f "APOP ~a ~a" login digest)))) - (set-pop3-connection:login connection login) - (set-pop3-connection:password connection password) - (set-pop3-connection:state connection 'connected) + (set-pop3-connection-login! connection login) + (set-pop3-connection-password! connection password) + (set-pop3-connection-state! connection 'connected) status)) @@ -233,14 +233,14 @@ (define (pop3-get connection msgid) (pop3-check-transaction-state connection 'pop3-get) (let ((status (pop3-send-command connection (format #f "RETR ~a" msgid)))) - (pop3-dump (socket:inport (pop3-connection:command-socket connection))) + (pop3-dump (socket:inport (pop3-connection-command-socket connection))) status)) ;;: connection x integer -> status (define (pop3-headers connection msgid) (pop3-check-transaction-state connection 'pop3-headers) (let ((status (pop3-send-command connection (format #f "TOP ~a 0" msgid)))) - (pop3-dump (socket:inport (pop3-connection:command-socket connection))) + (pop3-dump (socket:inport (pop3-connection-command-socket connection))) status)) ;; Return highest accessed message-id number for the session. This @@ -270,21 +270,23 @@ (define (pop3-quit connection) (pop3-check-transaction-state connection 'pop3-quit) (let ((status (pop3-send-command connection "QUIT"))) - (close-socket (pop3-connection:command-socket connection)) + (close-socket (pop3-connection-command-socket connection)) status)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Nothing exported below. -(define-record pop3-connection - host-name - command-socket - logfd - login - password - challenge - state) +(define-record-type pop3-connection :pop3-connection + (make-pop3-connection host-name command-socket logfd login password challenge state) + pop3-connection + (host-name pop3-connection-host-name) + (command-socket pop3-connection-command-socket) + (logfd pop3-connection-logfd) + (login pop3-connection-login set-pop3-connection-login!) + (password pop3-connection-password set-pop3-connection-password!) + (challenge pop3-connection-challenge set-pop3-connection-challenge!) + (state pop3-connection-state set-pop3-connection-state!)) ;; cf /usr/local/src/scheme48-0.49/scheme/rts/condition.scm (define-condition-type '-ERR '(error)) @@ -292,11 +294,11 @@ (define (pop3-check-transaction-state connection caller) - (if (not (eq? (pop3-connection:state connection) 'connected)) + (if (not (eq? (pop3-connection-state connection) 'connected)) (call-error "not in transaction state" caller))) (define (pop3-read-response connection) - (let* ((sock (pop3-connection:command-socket connection)) + (let* ((sock (pop3-connection-command-socket connection)) (IN (socket:inport sock)) (line (read-line IN))) (pop3-log connection (format #f "-> ~a" line)) @@ -314,14 +316,14 @@ (define (pop3-log connection line) - (let ((LOG (pop3-connection:logfd connection))) + (let ((LOG (pop3-connection-logfd connection))) (and LOG (write-string line LOG) (write-string "\n" LOG) (force-output LOG)))) (define (pop3-send-command connection command) - (let* ((sock (pop3-connection:command-socket connection)) + (let* ((sock (pop3-connection-command-socket connection)) (OUT (socket:outport sock))) (write-string command OUT) (write-crlf OUT) diff --git a/scheme/packages.scm b/scheme/packages.scm index aaa96f5..a176395 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -521,7 +521,7 @@ (define-structure pop3 pop3-interface (open scheme-with-scsh netrc - defrec-package + define-record-types handle conditions signals