Use DEFINE-RECORD-TYPES instead of DEFREC-PACKAGE in POP3.

This commit is contained in:
sperber 2002-12-03 10:55:08 +00:00
parent 0db1d98d53
commit 29fc6b1b9d
2 changed files with 29 additions and 27 deletions

View File

@ -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)

View File

@ -521,7 +521,7 @@
(define-structure pop3 pop3-interface
(open scheme-with-scsh
netrc
defrec-package
define-record-types
handle
conditions
signals