Use DEFINE-RECORD-TYPES instead of DEFREC-PACKAGE in POP3.
This commit is contained in:
parent
0db1d98d53
commit
29fc6b1b9d
|
@ -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)
|
||||
|
|
|
@ -521,7 +521,7 @@
|
|||
(define-structure pop3 pop3-interface
|
||||
(open scheme-with-scsh
|
||||
netrc
|
||||
defrec-package
|
||||
define-record-types
|
||||
handle
|
||||
conditions
|
||||
signals
|
||||
|
|
Loading…
Reference in New Issue